Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование строки по условию - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Копирование строки по условию
bigggi Дата: Вторник, 01.12.2015, 21:14 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Привет)
Помогите пожалуйста с макросом копирования по заданному слову.
Вот кусок кода но он копирует только все из столбца А (уже найденные результаты по ключевому слову) в столбец Е
с поиском все в порядке меня устраивает. Но как сделать так чтобы из строки где найдено слово скопировать всю строку например от А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
   
End Sub

[/vba]

Автор - bigggi
Дата добавления - 01.12.2015 в 21:14
Manyasha Дата: Вторник, 01.12.2015, 21:41 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 902 ±
Замечаний: 0% ±

Excel 2010, 2016
bigggi, не поняла...вроде так макрос и делает:
от А5 до С5 и вставить в E1:G1


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеbigggi, не поняла...вроде так макрос и делает:
от А5 до С5 и вставить в E1:G1

Автор - Manyasha
Дата добавления - 01.12.2015 в 21:41
bigggi Дата: Среда, 02.12.2015, 01:16 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Я тоже так думал, но на практике оказалось что либо трижды выводило данные найдинные например напишу так.

Таблица : до выполнения макроса

___А______В____С.......
1.google 2 7
2.yandex 8 1
3.mail 3 5
4.yandex 4 9

Таблица после запуска макроса:
...Е________F___G
1.yandex 8 1
2.yandex 4 9

Вот ) но данный макрос почему то етого не делает(( либо в столбци EFG вставляет везде одно и тоже yandex yandex yandex... Либо же вообще пусто(
Спасибо
 
Ответить
СообщениеЯ тоже так думал, но на практике оказалось что либо трижды выводило данные найдинные например напишу так.

Таблица : до выполнения макроса

___А______В____С.......
1.google 2 7
2.yandex 8 1
3.mail 3 5
4.yandex 4 9

Таблица после запуска макроса:
...Е________F___G
1.yandex 8 1
2.yandex 4 9

Вот ) но данный макрос почему то етого не делает(( либо в столбци EFG вставляет везде одно и тоже yandex yandex yandex... Либо же вообще пусто(
Спасибо

Автор - bigggi
Дата добавления - 02.12.2015 в 01:16
_Boroda_ Дата: Среда, 02.12.2015, 01:33 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 17006
Репутация: 6667 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
А так?
[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
[/vba]
К сообщению приложен файл: 717674367.xlsm (16.4 Kb) · 717674367_1.xlsm (16.6 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА так?
[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
[/vba]

Автор - _Boroda_
Дата добавления - 02.12.2015 в 01:33
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!