» Excel VBA (часть 2)

Pravoved90
Вот код, насколько понял с вашего примера


Код:
Sub Copy()
Dim i As Integer
Dim CheckColumn As Integer


Sheets("ИТОГ").Range("H6:J9").Copy
Sheets("Архив").Activate

For i = 1 To 1000
If IsEmpty(Cells(2, i)) And IsEmpty(Cells(2, i + 1)) Then
CheckColumn = i + 1
Exit For
End If
Next i

Cells(2, CheckColumn).Select
ActiveSheet.Paste

End Sub

помогите ещё с одним скриптом
к примеру есть коды товара:
01
01-01
01-01-1
01-01-1-01
01-01-1-02
01-01-1-03

02-04-2-07
02-04-2-07-1
02-04-2-07-2
02-04-2-07-3
02-04-2-07-4
и т.д.

в коде товара присутствуют одноразрядные цифры, нужно заменить эти одноразрядные на двухразрядные, т.е. перед цифрой поставить ноль
должно быть так
01
01-01
01-01-01
01-01-01-01
01-01-01-02
01-01-01-03

02-04-02-07
02-04-02-07-01
02-04-02-07-02
02-04-02-07-03
02-04-02-07-04

p.s. небольшая "подсказка": одноразрядные цифры в коде получаются, когда, например, в группе позиций товара меньше 10, это же относится и к самим группа и их подгруппам

казалось бы все можно сделать простой заменой в самом Excel, но это не работает для кода товара 02-04-2-07-1 или 02-04-2-07-12
т.к. -1 и т.д. встречается и в других ячейках не относящихся к коду или с двухзначным кодом

заранее спасибо

Pravoved90

Цитата:

Можно и такой вариант(конечно автоматом), только скажите - как?...)))

Предположим у тебя на листе "Архив" столбцы данных начинаются со столбца "А" и строки 5. И идут сплошником...
Что делаем:
Sheets("Архив").Select 'Выбираем лист "Архив"
CheckColumn = Cells(5, 1).End(xlToRight).Column + 1 'Присвоили переменной номер первого пустого столбца

А дальше твори с ним что хочешь.

НАРОД ПОМОГИТЕ. Такой вопрос. Я новичок в програмирование на VBA и мне нужна помощь!
Есть документ ексель он содержить примерно 50 листов, нужно поставить на первый лист одну кнопку и при его нажатии на ВСЕХ листах в одном документе, на первом столбце каждого листа заполнились нолями. НАДЕЮСЬ НА ВАШУ ПОМОЩЬ. СПАСИБО!!!

MaximuS G
Oyger
Огромное спасибо за помощь))) Сейчас буду пробовать. Как и что - отпишусь))

KVDvadim

немного не понятно весь первый столбец надо заполнить или только часть
но в любом случае код будет примерно такой
в кнопке, на событие Click надо написать

Dim sht As Worksheet

For Each sht In ActiveWorkbook.Sheets
sht.Range("A:A") = 0
Next

если заполнять не всесь столбец, то надо поправить "A:A" на свой диапозон.

Oyger

Цитата:

CheckColumn = Cells(5, 1).End(xlToRight).Column

попробывал у себя, вправо работает нормально, а вот влево например
CheckColumn = cells(6, 5).End(xlToLeft).Column
CheckColumn = cells(6, 5).End(xlToUp).Row 'вверх
CheckColumn = cells(6, 5).End(xlToDown).Row 'вниз
выдает неправильные значение, почему ?

Может не так пишу, или сдесь есть какая-то хитрость ?
Я искал все время циклом... вот в примере там 2 пустые клеточки, можна ли решить
это этим же методом ?

tavz

ОГРОМНОЕ СПАСИБО работает!!!
и еще вопросик, как определить в Excel последнюю строку, входящую на лист
или - количество строк, чтобы при нажатии кнопки она заполнила ноликами до последней заполненой строки на каждом листе? к етому коду. СПАСИБО!!!

Dim sht As Worksheet

For Each sht In ActiveWorkbook.Sheets
sht.Range("A:A") = 0
Next

Добрый вечер, Господа. Немного вернусь назад.
Задавал такой вопрос:

Цитата:
Есть ячейки а1 в1 с1 d1. Нужно сделать формулу в ячейке a1, чтобы в случае, если в1 = от 1 до 5, a1 = d1, если b1 = от 5 до 10, a1 =c1.
Можно ли єто сделать в одной формуле, или надо макрос писать?
ПС Хотелось бы первый вариант, но не могу сообразить..Спасибо

И получил в общем правильный ответ:
Цитата:
Чего там делать. =ЕСЛИ(ИЛИ(B1<1;B1>10);"нет данных";ЕСЛИ(B1<5;D1;C1))

Только появился один нюанс. Вариантов ЕСЛИ более двух. Следовательно формула выдает ошибку "слишком длинное приложение"
Можно ли это дело обойти без макроса? Если нет, то как его примерно написать?(сама часть "если значение больше\меньше, то...")

KVDvadim

вариантов несколько:

sht.UsedRange.Columns(1) - выбирает первую колонку во всем используемом диапазоне ячеек на листе
sht.Cells(1, 1).CurrentRegion.Columns(1) - выбирет таблицу в которой находится ячейка (в данном случае "А1")
sht.Cells(1, 1).End(xlDown) - выбирает непрерывный диапазон ячеек, от "А1" до первой пустой вниз
Range(sht.Cells(1, 1), sht.Cells(65536, 1).End(xlUp)) - выбирает диапазон от "А1" до последней используемой в столбце "А:А"

выбири который больше подходит...

MaximuS G

Цитата:

например я укажу верхнюю границу 1000, а елементов будет 100, какие значения будут у остальных

Mожно использовать ReDim или Redim Preserve
Dim ar()
Redim ar(23)
ar(12)=0
ReDim Preserve ar(20)

Вобщем вопрос сошел к простому: как указать в макросе диапазон чисел в ячейке, например: >1<5?

Pravoved90
не совсем понятно..
Вы про это:
Код: If ([a1] > 1) And ([a1] < 5) Then

dneprcomp
Спасибо! Завтра на работе буду ставить эксперименты по отправке автоматического "мыла" по почте.

И самый крамольный вопрос: А можно ли через VBA для Excel управлять радмином?

Solenaja
попробуйте код [more]
Код: [no]
Sub AddZero()
Dim i&, FirstRow&, LastRow&, p1&, p2%
Dim Cur_Cell_Type As String, s As String, sbstr As String
Dim WasChanged As Boolean
' Dim r As Range

FirstRow = ActiveWorkbook.ActiveSheet.UsedRange.Row
LastRow = FirstRow + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1

' как вариант можно пройтись только по выделенным
' For Each r In Selection
For i = FirstRow To LastRow
If Not IsEmpty(Cells(i, "A")) Then
Cur_Cell_Type = TypeName(Cells(i, "A").Value)
If (Cur_Cell_Type = "String") And (Len(Trim(Cells(i, "A").Value)) > 1) Then
s = Trim(Cells(i, "A").Value) + "-" ' временно добавим '-' в конец, потом удалим
p1 = 1
p2 = InStr(p1, s, "-")
WasChanged = False
While p2 > 0
' MsgBox "p1 = " & p1 & " substr= " & Mid(s, p1, p2 - p1)
sbstr = Mid(s, p1, p2 - p1)
If (Len(sbstr) = 1) And (CDbl(sbstr) > 0) Then
s = Mid(s, 1, p1 - 1) & "0" & sbstr & Mid(s, p2)
p2 = p2 + 1 ' потому как строчку раздвинули на один символ!
WasChanged = True ' отметим, что мы меняли текст
End If
p1 = p2 + 1
p2 = InStr(p1, s, "-")
Wend
If WasChanged Then Cells(i, "A").Value = Mid(s, 1, Len(s) - 1)
End If
End If
Next i
End Sub
[/no]

CEMEH
Управлять - не знаю. А вот вызывать с параметрами(если радмин имеет) - почему нет

SERGE_BLIZNUK

Цитата:

Вы про это:
Код:
If ([a1] > 1) And ([a1] < 5) Then
?

Именно про это))) Премного признателен за помощь))

SERGE_BLIZNUK
в коде [more]' Добавление ноля в код продукции
Sub AddZero()
Dim i&, FirstRow&, LastRow&, p1&, p2%
Dim Cur_Cell_Type As String, s As String, sbstr As String
Dim WasChanged As Boolean
' Dim r As Range

FirstRow = ActiveWorkbook.ActiveSheet.UsedRange.Row
LastRow = FirstRow + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1

' как вариант можно пройтись только по выделенным
' For Each r In Selection
For i = FirstRow To LastRow
If Not IsEmpty(Cells(i, "A")) Then
Cur_Cell_Type = TypeName(Cells(i, "A").Value)
If (Cur_Cell_Type = "String") And (Len(Trim(Cells(i, "A").Value)) > 1) Then
s = Trim(Cells(i, "A").Value) + "-" ' временно добавим '-' в конец, потом удалим
p1 = 1
p2 = InStr(p1, s, "-")
WasChanged = False
While p2 > 0
' MsgBox "p1 = " & p1 & " substr= " & Mid(s, p1, p2 - p1)
sbstr = Mid(s, p1, p2 - p1)
If (Len(sbstr) = 1) And (CDbl(sbstr) > 0) Then
s = Mid(s, 1, p1 - 1) & "0" & sbstr & Mid(s, p2)
p2 = p2 + 1 ' потому как строчку раздвинули на один символ!
WasChanged = True ' отметим, что мы меняли текст
End If
p1 = p2 + 1
p2 = InStr(p1, s, "-")
Wend
If WasChanged Then Cells(i, "A").Value = Mid(s, 1, Len(s) - 1)
End If
End If
Next i
End Sub[/more]

excel 2007 выдаёт ошибку "Can't execute code in break mode" в строке
If (Len(sbstr) = 1) And (CDbl(sbstr) > 0) Then

Необходимо упростить работу в таблице, по добавлению строк и групп, при этом необходимо изменение (расчет) формул.
Возможно ли это решить макросом с 1-2 кнопками?
Табличка и желания прикрепляются

http://files.mail.ru/B4DM81

Solenaja
ну нет у меня 2007го... :-((
а попробуйте заменить строчку на:
If (Len(sbstr) = 1) And (val(sbstr) > 0) Then

SERGE_BLIZNUK
If (Len(sbstr) = 1) And (val(sbstr) > 0) Then
так работает - СПАСИБО!!!

а можно ли ещё одно маленькое дополнение к этому коду сделать?
чтобы в начале каждого кода товара, например, 01-01-1 стоял апостроф, тк он такого вида код переводит в дату

угу. имхо, легко. попробуйте, перед тем, где присвоение:

Код: if inStr(1,s,"'")<>1 then s = "'" & s
If WasChanged Then Cells(i, "A").Value = Mid(s, 1, Len(s) - 1)

Уважаемые специалисты, снова и ОЧЧень нужна помощь.
Есть некая форула, например:
=Лист1!$D$6*5/7
Подскажите, как правильно записать в макросе такое условие:
Если значение этой формулы = <5, выполнить Макрос1

Может ли макрос делать это вычисление сам и сразу, или обезательно надо ссылаться на ячейку-вычесление?(мне желетельно первый вариант)
Заранее благодарю за ответ

Pravoved90
допустим ЭТА формула записана в ячейке B10 в листе Лист2
тогда для ЭТОГО листа, для события Worksheet_Change пишем ...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "B10" Then
If Target.Value <= 5 Then
Call Макрос1
End If
End If
End Sub

WowGun
Спасибо, сейчас буду пробовать..Подскажите кто знает, ответ на простой вопросик.
Можно ли задать для условия Worksheet_SelectionChange
его исполнение не при одинарном, а к примеру, при ДВОЙНОМ нажатии на ячейку(для избежания исполнения при случайном нажатии)

Pravoved90
Цитата:

исполнение не при одинарном, а к примеру, при ДВОЙНОМ нажатии на ячейку

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

q1wed
Работает))

Под вечер ексель обрадовал новой проблемой...
Есть макрос:
If Not Intersect(Target, Range("D20")) Is Nothing Then
Application.EnableEvents = False
If Range("D20").Value = "первый" Then
Макрос7
Макрос1
If Range("D20").Value = "второй" Then
Копи20
Макрос7
Макрос2
If Range("D20").Value = "третий" Then
Макрос7
Макрос3
End If
Application.EnableEvents = True
End If

В общем не отличается ничем от всех ему идентичных. Все работало нормально, но в один момент случилось следующее: После нажатия нажатия в ячейке на варианты "второй" или "третий" стабильно отключаються все макросы в книге. Помогает только перезапуск книги. Такое было, когда писал неправильно формулу, но тогда сразу кидало в макрос для исправлении ошибки..А тут глухо..Даже не знаю, куда копать..Есть какое то теоретическое обоснование этой проблемы? Есть ли какая то функция в екселе по поиску таких ошибок?..

Вот сбил на скорую руку образец:
http://rapidshare.com/files/146687307/Obrazecpravoved911.xls.html
В листе Условия есть пункт Выходные в ячейке а20. Рядом подпункты из выпадающего списка в ячейке D20: "Есть", "Нет", "понедельно".
При выборе значение из выпадающего списка, исполняется макрос, который производит копирование в Листе ИТОГ.
ПРОБЛЕМА: Если выбрать значение "Нет" или "понедельно", они естественно не выполняються + отключаються все макросы в книге.(не срабатывают при выборе выпадающих значений в других пунктах).
Подскажите, в чем проблема...Уже и поудалял все, что можно, и чего то химичить пытался..без результатов(((((
В другую ячейку поместить тоже не вариант - все на макросах и рядах связано...

На ВАС вся надежда...((((

образец не смотрел но наверняка это происходит из-за того что у тебя не срабатывает Application.EnableEvents = True.
Проверить можно так:
Application.EnableEvents = False
MsgBox ("События отключены")
......
Application.EnableEvents = True
MsgBox ("События включены")

Если сообщение "События включены" не появляется - значит это оно и есть в какой то момент что то сбоит - включение событий не включается и события Change, Selection, DoubleClick и etc не обрабатываются.

Добавлено:
Pravoved90
зачем так много If используешь? так не красиво и не правильно!
я тебе высылал пример где используется Select Case - так намного лучше

q1wed
Добавил MsgBox после каждого события.
Получилось, что в момент выполнения глючного значения в начале на Application.EnableEvents = False - срабатывает,
на следующее событие - уже нет..
Стало быть, ошибка за False...Знать бы еще что это и как с ним бороться?....
Еще выяснил несколько фактов:
От значения вводимого слова ошибка не зависит, стало быть - от ячейки?Или порядка вводимых значений?...
После отключения макросов, они не срабатывают даже во вновь открытой другой книге, если при этом была открыта глючная с запущенной ошибкой...