Application.Workbooks.Item("Ñðàâíèòåëüíàÿ 2007").Worksheets(list).Activate
Range("B" & i).Select
str = ActiveCell.Cells.Value
If str = "" Then GoTo line
With Application.Workbooks("Ïðàéñû Excel.xls").Sheets("Ïðàéñ").Cells
Set c = .Find(str, Cells(, 19), xlValues, xlPart)
If Not c Is Nothing Then
fistaddress = c.Address
Range("C" & i).Value = Workbooks(Filename).Sheets("Ïðàéñ").[/FONT]Range(fistaddress).Offset(0, -17).Value
Range("E" & i).Value = Workbooks(Filename).Sheets("Ïðàéñ").Range(fistaddress).Offset(0, -16).Value
Range("F" & i).Value = Workbooks(Filename).Sheets("Ïðàéñ").Range(fistaddress).Offset(0, -14).Value
Range("G" & i).Value = Workbooks(Filename).Sheets("Ïðàéñ").Range(fistaddress).Offset(0, -13).Value
Range("J" & i).Value = Workbooks(Filename).Sheets("Ïðàéñ").Range(fistaddress).Offset(0, -5).Value
End If
End With
Next i
Прошу помощи в дописании макроса под Excel
Есть кусок кода в котором ведется поиск по заданным данным в двух книгах.
при данном выпонении находится одно значение при поиске, мне надо немного поменять код, так чтобы происходил еще поиск и при нахождении повторяющегося значения, адреса ячеек заносились в переменную fistaddress(). Пробовал вставлять вот такой код
но ничего не получается. Кто может, прошу помощи.
P.S. На абракадабры не смотрите, там что-то с русским шрифтом.
Код:
при данном выпонении находится одно значение при поиске, мне надо немного поменять код, так чтобы происходил еще поиск и при нахождении повторяющегося значения, адреса ячеек заносились в переменную fistaddress(). Пробовал вставлять вот такой код
Код:
For i1 = 0 To 10
'With Application.Workbooks("Ïðàéñû Excel.xls").Sheets("Ïðàéñ").Cells
Set c = .FindNext(str, Cells(, 19))
If Not c Is Nothing Then
fistaddress = c.Address
End If
Next i1
'With Application.Workbooks("Ïðàéñû Excel.xls").Sheets("Ïðàéñ").Cells
Set c = .FindNext(str, Cells(, 19))
If Not c Is Nothing Then
fistaddress = c.Address
End If
Next i1
но ничего не получается. Кто может, прошу помощи.
P.S. На абракадабры не смотрите, там что-то с русским шрифтом.
Код:
Private Sub FindAllCells()
With ThisWorkbook.Worksheets(1).UsedRange
'Укажите нужную рабочую книгу и рабочий лист
Dim iCell As Range, iDuplicate As Range
Set iCell = .Find(What:="Аркадий Б.", LookIn:=xlValues, LookAt:=xlWhole)
If Not iCell Is Nothing Then
iAddress$ = iCell.Address
Set iDuplicate = iCell
Do
Set iCell = .FindNext(After:=iCell)
Set iDuplicate = Union(iDuplicate, iCell)
Loop While iCell.Address <> iAddress$
MsgBox "Адреса ячеек, содержащих искомое значение : " & _
vbNewLine & iDuplicate.Address, vbInformation, ""
'Обратите внимание на то, что iDuplicate это диапазон ячеек,
'а это значит, что вместо
'Range(iDuplicate.Address). лучше использовать iDuplicate.
Else
MsgBox "Увы, ничего не найдено", vbCritical, ""
End If
End With
End Sub
With ThisWorkbook.Worksheets(1).UsedRange
'Укажите нужную рабочую книгу и рабочий лист
Dim iCell As Range, iDuplicate As Range
Set iCell = .Find(What:="Аркадий Б.", LookIn:=xlValues, LookAt:=xlWhole)
If Not iCell Is Nothing Then
iAddress$ = iCell.Address
Set iDuplicate = iCell
Do
Set iCell = .FindNext(After:=iCell)
Set iDuplicate = Union(iDuplicate, iCell)
Loop While iCell.Address <> iAddress$
MsgBox "Адреса ячеек, содержащих искомое значение : " & _
vbNewLine & iDuplicate.Address, vbInformation, ""
'Обратите внимание на то, что iDuplicate это диапазон ячеек,
'а это значит, что вместо
'Range(iDuplicate.Address). лучше использовать iDuplicate.
Else
MsgBox "Увы, ничего не найдено", vbCritical, ""
End If
End With
End Sub
"Абра-кадабра" появляется на форуме, когда вы копируете текст макроса в редакторе VBE с ангийской раскладкой клавиатуры. Если переключиться на русскую раскладку, скопировать текст и вставиь его на форум, то "абра-кадабры" не будет, а будет читабельный русский текст )
Спасибо Pashulka за помощь, разобрался, только есть еще вопрос.
мне надо вызвать форму в которой динамически создавались радио-кнопки(optionbutton) и напротив них были надписи (label). т.е. в цикле сделать, не могу найти команду создания на форме объектов. остальное попробую доделать сам.
мне надо вызвать форму в которой динамически создавались радио-кнопки(optionbutton) и напротив них были надписи (label). т.е. в цикле сделать, не могу найти команду создания на форме объектов. остальное попробую доделать сам.
Спасибо Pavel55, буду иметь ввиду!!!
Вот пример программного создания элемента управления OptionButton, а также, изменение значений некоторых свойств этого контрола и использование событий.
Цикл Вы без труда добавите сами, для создания надписей используйте "Forms.Label.1", а если надумаете создать массив элементов управления в VBA, то рекомендую заглянуть сюда.
Код:
Private WithEvents iOptionButton As MSForms.OptionButton
'Данное событие и функция используются только в качестве примера.
Private Sub iOptionButton_Click()
MsgBox "Состояние : " & iOptionButton.Value
End Sub
Private Sub UserForm_Initialize()
Set iOptionButton = Me.Controls.Add( _
"Forms.OptionButton.1", "OptionButton1", True)
With iOptionButton
.Left = 25
.Top = 10
.Caption = "Флажок"
.SpecialEffect = fmButtonEffectSunken
End With
End Sub
'Данное событие и функция используются только в качестве примера.
Private Sub iOptionButton_Click()
MsgBox "Состояние : " & iOptionButton.Value
End Sub
Private Sub UserForm_Initialize()
Set iOptionButton = Me.Controls.Add( _
"Forms.OptionButton.1", "OptionButton1", True)
With iOptionButton
.Left = 25
.Top = 10
.Caption = "Флажок"
.SpecialEffect = fmButtonEffectSunken
End With
End Sub
Цикл Вы без труда добавите сами, для создания надписей используйте "Forms.Label.1", а если надумаете создать массив элементов управления в VBA, то рекомендую заглянуть сюда.
т.е. нужно создавать объект, а ему давать свойства optionbutton. с этим разобрался, дописал вроде бы все, только не нашел, как сделать при нажатии на кнопку - остановить выполнение макроса. Exit .........???
Если Вы хотите остановить выполнение некого макроса - нажатием кнопки, то можно использовать следующий вариант.
Код:
Private iExitMacro As Boolean
Private Sub StartMacro()
Do
DoEvents
If iExitMacro = True Then
iExitMacro = False 'iExitMacro = Not iExitMacro
Exit Sub
End If
'Можно вызывать функцию DoEvents, не так часто, например :
'iCount = iCount + 1
'If iCount Mod 100 = 0 Then
' DoEvents
' ...
'End If
Loop
'Имитация Вашего макроса
End Sub
Private Sub CommandButton2_Click()
iExitMacro = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
iExitMacro = True
End Sub
Private Sub StartMacro()
Do
DoEvents
If iExitMacro = True Then
iExitMacro = False 'iExitMacro = Not iExitMacro
Exit Sub
End If
'Можно вызывать функцию DoEvents, не так часто, например :
'iCount = iCount + 1
'If iCount Mod 100 = 0 Then
' DoEvents
' ...
'End If
Loop
'Имитация Вашего макроса
End Sub
Private Sub CommandButton2_Click()
iExitMacro = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
iExitMacro = True
End Sub