Привет) Помогите пожалуйста с макросом копирования по заданному слову. Вот кусок кода но он копирует только все из столбца А (уже найденные результаты по ключевому слову) в столбец Е с поиском все в порядке меня устраивает. Но как сделать так чтобы из строки где найдено слово скопировать всю строку например от А5 до С5 и вставить в E1:G1 и так дале по цыклу. Спасибо. [vba]
Код
Option Explicit
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value Set objC = [a1].CurrentRegion.Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value Set objC = [a1].CurrentRegion.FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A
End Sub
[/vba]
Привет) Помогите пожалуйста с макросом копирования по заданному слову. Вот кусок кода но он копирует только все из столбца А (уже найденные результаты по ключевому слову) в столбец Е с поиском все в порядке меня устраивает. Но как сделать так чтобы из строки где найдено слово скопировать всю строку например от А5 до С5 и вставить в E1:G1 и так дале по цыклу. Спасибо. [vba]
Код
Option Explicit
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value Set objC = [a1].CurrentRegion.Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value Set objC = [a1].CurrentRegion.FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A
Вот ) но данный макрос почему то етого не делает(( либо в столбци EFG вставляет везде одно и тоже yandex yandex yandex... Либо же вообще пусто( Спасибо
Я тоже так думал, но на практике оказалось что либо трижды выводило данные найдинные например напишу так.
Вот ) но данный макрос почему то етого не делает(( либо в столбци EFG вставляет везде одно и тоже yandex yandex yandex... Либо же вообще пусто( Спасибо bigggi
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value Set objC = [a1].CurrentRegion.Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value A(lngI, 2) = objC.Offset(, 1).Value A(lngI, 3) = objC.Offset(, 2).Value Set objC = [a1].CurrentRegion.FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A End Sub
[/vba] Или так [vba]
Код
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value r_ = [a1].CurrentRegion.Rows.Count Set objC = Range("A1:A" & r_).Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value A(lngI, 2) = objC.Offset(, 1).Value A(lngI, 3) = objC.Offset(, 2).Value Set objC = Range("A1:A" & r_).FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A End Sub
[/vba]
А так? [vba]
Код
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value Set objC = [a1].CurrentRegion.Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value A(lngI, 2) = objC.Offset(, 1).Value A(lngI, 3) = objC.Offset(, 2).Value Set objC = [a1].CurrentRegion.FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A End Sub
[/vba] Или так [vba]
Код
Sub t() Dim objC As Range Dim lngI As Long Dim strA As String Dim A() As Variant A = [a1].CurrentRegion.Value r_ = [a1].CurrentRegion.Rows.Count Set objC = Range("A1:A" & r_).Find("yandex", LookIn:=xlValues) lngI = 1 If Not objC Is Nothing Then strA = objC.Address Do A(lngI, 1) = objC.Value A(lngI, 2) = objC.Offset(, 1).Value A(lngI, 3) = objC.Offset(, 2).Value Set objC = Range("A1:A" & r_).FindNext(objC) lngI = lngI + 1 Loop While Not objC Is Nothing And objC.Address <> strA End If [e1].Resize(lngI - 1, 3).Value = A End Sub