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

Вход

Регистрация

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

 

= Мир MS Excel/Автоматический поиск и вставка - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматический поиск и вставка (Макросы/Sub)
Автоматический поиск и вставка
evfron Дата: Среда, 08.11.2017, 16:47 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток! Возник вопрос автоматизации ручной работы, а именно из 1 файла который автоматически выгружается из программы необходимо перенести информацию в другой файл. А в этом файле взять столбец А с листа info, найти совпадение в "листе2" этого же файла и если найдено то скопировать найденные значения и вставить в столбцы B и C, продолжать процедуру до тех пор пока в столбце A есть данные. В VBA не силен, поэтому уже несколько дней ломаю голову как это сделать. Помогите примером или подтолкните в нужном направлении. Файл с примером прилагаю.
Код вставки из файла в файл(написал на что хватило мозгов)
[vba]
Код
Sub Вставка_из_файла_выгрузки()

Workbooks.Open Filename:="C:\Downloads\Orders .xlsx"
Workbooks("Orders .xlsx").Worksheets("Orders").Range("A3:A300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("A2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("B3:B300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("D2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("N3:N300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("AB2").Select
ActiveSheet.Paste
Range("E2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[23])"
Selection.AutoFill Destination:=Range("E2:E300"), Type:=xlFillDefault
Range("F2").Select
ActiveCell.FormulaR1C1 = "=TIME(HOUR(RC[22]),MINUTE(RC[22]),SECOND(RC[22]))"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F300"), Type:=xlFillDefault
Workbooks("Orders .xlsx").Worksheets("Orders").Range("C3:C300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("G2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("U3:U300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("H2").Select
ActiveSheet.Paste
End Sub

[/vba]
К сообщению приложен файл: __.xlsx (15.0 Kb)
 
Ответить
СообщениеДоброго времени суток! Возник вопрос автоматизации ручной работы, а именно из 1 файла который автоматически выгружается из программы необходимо перенести информацию в другой файл. А в этом файле взять столбец А с листа info, найти совпадение в "листе2" этого же файла и если найдено то скопировать найденные значения и вставить в столбцы B и C, продолжать процедуру до тех пор пока в столбце A есть данные. В VBA не силен, поэтому уже несколько дней ломаю голову как это сделать. Помогите примером или подтолкните в нужном направлении. Файл с примером прилагаю.
Код вставки из файла в файл(написал на что хватило мозгов)
[vba]
Код
Sub Вставка_из_файла_выгрузки()

Workbooks.Open Filename:="C:\Downloads\Orders .xlsx"
Workbooks("Orders .xlsx").Worksheets("Orders").Range("A3:A300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("A2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("B3:B300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("D2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("N3:N300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("AB2").Select
ActiveSheet.Paste
Range("E2").Select
ActiveCell.FormulaR1C1 = "=TRUNC(RC[23])"
Selection.AutoFill Destination:=Range("E2:E300"), Type:=xlFillDefault
Range("F2").Select
ActiveCell.FormulaR1C1 = "=TIME(HOUR(RC[22]),MINUTE(RC[22]),SECOND(RC[22]))"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F300"), Type:=xlFillDefault
Workbooks("Orders .xlsx").Worksheets("Orders").Range("C3:C300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("G2").Select
ActiveSheet.Paste
Workbooks("Orders .xlsx").Worksheets("Orders").Range("U3:U300").Copy
Workbooks("пример для форума.xlsx").Activate
ActiveWorkbook.Worksheets("Info").Range("H2").Select
ActiveSheet.Paste
End Sub

[/vba]

Автор - evfron
Дата добавления - 08.11.2017 в 16:47
evfron Дата: Среда, 08.11.2017, 16:55 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
На просторах интернета нашел что данную задачу можно реализовать с помощью find, но мозгов описать это не хватает
 
Ответить
СообщениеНа просторах интернета нашел что данную задачу можно реализовать с помощью find, но мозгов описать это не хватает

Автор - evfron
Дата добавления - 08.11.2017 в 16:55
InExSu Дата: Среда, 08.11.2017, 23:39 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
]Доброго времени суток!
На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
Сообщение]Доброго времени суток!
На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?

Автор - InExSu
Дата добавления - 08.11.2017 в 23:39
evfron Дата: Четверг, 09.11.2017, 08:12 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
]Доброго времени суток!
На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?
Ищем совпадение на листе LTC во втором столбце и если нашли то скопировать найденное значение из двух столбцов и вставить в лист info в столбцы С D. В файле во вкладке Лист2 написал как я это вижу
К сообщению приложен файл: 0613461.xlsx (16.1 Kb)


Сообщение отредактировал evfron - Четверг, 09.11.2017, 08:12
 
Ответить
Сообщение
]Доброго времени суток!
На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?
Ищем совпадение на листе LTC во втором столбце и если нашли то скопировать найденное значение из двух столбцов и вставить в лист info в столбцы С D. В файле во вкладке Лист2 написал как я это вижу

Автор - evfron
Дата добавления - 09.11.2017 в 08:12
Pelena Дата: Четверг, 09.11.2017, 08:42 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19162
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Формулами не подойдёт?
К сообщению приложен файл: 6292906.xlsx (20.4 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеФормулами не подойдёт?

Автор - Pelena
Дата добавления - 09.11.2017 в 08:42
evfron Дата: Четверг, 09.11.2017, 10:17 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Из проделанной вами работы результат на лицо, но хочется не растягивать формулу на н-ное количество строк, а заполнять по нажатию кнопки выполнения макроса, так как выгрузка бывает разной. И судя по формуле он ищет точное совпадение, и если не находит то соответственно ничего не вставляет. Да я понимаю, что это причина не универсальности поискового запроса, от сюда в макросе можно будет указать критерий поиска, например добавлять к поисковому слову пробел в начале, и искать по первым 3-5 буквам.
 
Ответить
СообщениеИз проделанной вами работы результат на лицо, но хочется не растягивать формулу на н-ное количество строк, а заполнять по нажатию кнопки выполнения макроса, так как выгрузка бывает разной. И судя по формуле он ищет точное совпадение, и если не находит то соответственно ничего не вставляет. Да я понимаю, что это причина не универсальности поискового запроса, от сюда в макросе можно будет указать критерий поиска, например добавлять к поисковому слову пробел в начале, и искать по первым 3-5 буквам.

Автор - evfron
Дата добавления - 09.11.2017 в 10:17
evfron Дата: Вторник, 14.11.2017, 13:18 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Так и не смог ничего дельного написать своими силами, поэтому на просторах сети нашел подобный пример и адаптировал его под себя, но не могу понять следующее:

В примере было так, но на листе List в примере всего 1 столбик с данными

[vba]
Код
Sub Make_table()
Dim Foundrng As Range
Dim iLastRowListSht As Long, iLastRowTargetSht As Long, i As Long
Dim ListSht As Worksheet, SourceSht As Worksheet, TargetSht As Worksheet
Dim firstAddress As String

    Set ListSht = Worksheets("List")
    Set SourceSht = Worksheets("Source")
    Set TargetSht = Worksheets("Target")
    'определяем номер последней строки на листе List
    iLastRowListSht = ListSht.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowListSht = 1 Then
        MsgBox "Нет данных на листе 'List'", 48, "Ошибка"
        Exit Sub
    End If
    'цикл с 1-й строки по последнию
    For i = 1 To iLastRowListSht
        With SourceSht
            'осуществляем поиск кода на листе Source во втором столбце
            Set Foundrng = .Columns(2).Find(ListSht.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            'если нашли код
            If Not Foundrng Is Nothing Then
                With TargetSht
                    iLastRowTargetSht = .Cells(Rows.Count, 1).End(xlUp).Row + 2
                    'проставляем 6-ти значный код
                    .Cells(iLastRowTargetSht, 1) = ListSht.Cells(i, 1)
                End With
                'запоминаем адрес ячейки с первым найденным кодом
                firstAddress = Foundrng.Address
                'цикл для последующего поиска этого же кода
                Do
                    With TargetSht
                        iLastRowTargetSht = iLastRowTargetSht + 1
                        'проставляем город
                        .Cells(iLastRowTargetSht, 1) = Foundrng.Offset(0, -1)
                        'проставляем название машины
                        .Cells(iLastRowTargetSht, 2) = Foundrng
                        'проставляем цену
                        .Cells(iLastRowTargetSht, 3) = Foundrng.Offset(0, 1)
                    End With
                    'продолжаем поиск этого же кода
                    Set Foundrng = .Columns(2).FindNext(Foundrng)
                'выходим из цикла, если мы нашли все ячейки с этим кодом и снова вернулись к первой ячейке
                Loop Until Foundrng.Address = firstAddress
            End If
        End With
    Next i
    With TargetSht
        .Rows("1:2").Delete
        .Columns(2).AutoFit
    End With
    MsgBox "Макрос завершил свою работу", 64, ""
End Sub
[/vba]
как переменной region присвоить данные из столбца а листа info
[vba]
Код
Sub Region()
Dim Foundrng As Range
Dim iLastRowInfo As Long, iLastRowTargetSht As Long, i As Long
Dim Region As Worksheet, LTC As Worksheet, TargetSht As Worksheet
Dim firstAddress As String

    Set Region = Worksheets("Info").Range("A2:A300").Value
    Set LTC = Worksheets("LTC")
    Set TargetSht = Worksheets("Target")
    iLastRowInfo = Region.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowInfo = 1 Then
        MsgBox "Данные не найдены 'Info'", 48, "Ошибка"
        Exit Sub
    End If
    For i = 1 To iLastRowInfo
        With LTC
            Set Foundrng = .Columns(2).Find(Region.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            If Not Foundrng Is Nothing Then
               With TargetSht
                   iLastRowTargetSht = .Cells(Rows.Count, 1).End(xlUp).Row + 2
                   .Cells(iLastRowTargetSht, 1) = ListSht.Cells(i, 1)
                End With
                firstAddress = Foundrng.Address
                Do
                    With TargetSht
                        iLastRowTargetSht = iLastRowTargetSht + 1
                        .Cells(iLastRowTargetSht, 1) = Foundrng.Offset(0, -1)
                    End With
                    Set Foundrng = .Columns(2).FindNext(Foundrng)
                Loop Until Foundrng.Address = firstAddress
            End If
        End With
    Next i
    With TargetSht
        .Rows("1:2").Delete
        .Columns(2).AutoFit
    End With
    MsgBox "Кино закончилось", 64, ""
End Sub
[/vba]


Сообщение отредактировал evfron - Вторник, 14.11.2017, 13:29
 
Ответить
СообщениеТак и не смог ничего дельного написать своими силами, поэтому на просторах сети нашел подобный пример и адаптировал его под себя, но не могу понять следующее:

В примере было так, но на листе List в примере всего 1 столбик с данными

[vba]
Код
Sub Make_table()
Dim Foundrng As Range
Dim iLastRowListSht As Long, iLastRowTargetSht As Long, i As Long
Dim ListSht As Worksheet, SourceSht As Worksheet, TargetSht As Worksheet
Dim firstAddress As String

    Set ListSht = Worksheets("List")
    Set SourceSht = Worksheets("Source")
    Set TargetSht = Worksheets("Target")
    'определяем номер последней строки на листе List
    iLastRowListSht = ListSht.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowListSht = 1 Then
        MsgBox "Нет данных на листе 'List'", 48, "Ошибка"
        Exit Sub
    End If
    'цикл с 1-й строки по последнию
    For i = 1 To iLastRowListSht
        With SourceSht
            'осуществляем поиск кода на листе Source во втором столбце
            Set Foundrng = .Columns(2).Find(ListSht.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            'если нашли код
            If Not Foundrng Is Nothing Then
                With TargetSht
                    iLastRowTargetSht = .Cells(Rows.Count, 1).End(xlUp).Row + 2
                    'проставляем 6-ти значный код
                    .Cells(iLastRowTargetSht, 1) = ListSht.Cells(i, 1)
                End With
                'запоминаем адрес ячейки с первым найденным кодом
                firstAddress = Foundrng.Address
                'цикл для последующего поиска этого же кода
                Do
                    With TargetSht
                        iLastRowTargetSht = iLastRowTargetSht + 1
                        'проставляем город
                        .Cells(iLastRowTargetSht, 1) = Foundrng.Offset(0, -1)
                        'проставляем название машины
                        .Cells(iLastRowTargetSht, 2) = Foundrng
                        'проставляем цену
                        .Cells(iLastRowTargetSht, 3) = Foundrng.Offset(0, 1)
                    End With
                    'продолжаем поиск этого же кода
                    Set Foundrng = .Columns(2).FindNext(Foundrng)
                'выходим из цикла, если мы нашли все ячейки с этим кодом и снова вернулись к первой ячейке
                Loop Until Foundrng.Address = firstAddress
            End If
        End With
    Next i
    With TargetSht
        .Rows("1:2").Delete
        .Columns(2).AutoFit
    End With
    MsgBox "Макрос завершил свою работу", 64, ""
End Sub
[/vba]
как переменной region присвоить данные из столбца а листа info
[vba]
Код
Sub Region()
Dim Foundrng As Range
Dim iLastRowInfo As Long, iLastRowTargetSht As Long, i As Long
Dim Region As Worksheet, LTC As Worksheet, TargetSht As Worksheet
Dim firstAddress As String

    Set Region = Worksheets("Info").Range("A2:A300").Value
    Set LTC = Worksheets("LTC")
    Set TargetSht = Worksheets("Target")
    iLastRowInfo = Region.Cells(Rows.Count, 1).End(xlUp).Row
    If iLastRowInfo = 1 Then
        MsgBox "Данные не найдены 'Info'", 48, "Ошибка"
        Exit Sub
    End If
    For i = 1 To iLastRowInfo
        With LTC
            Set Foundrng = .Columns(2).Find(Region.Cells(i, 1), LookIn:=xlFormulas, lookat:=xlPart)
            If Not Foundrng Is Nothing Then
               With TargetSht
                   iLastRowTargetSht = .Cells(Rows.Count, 1).End(xlUp).Row + 2
                   .Cells(iLastRowTargetSht, 1) = ListSht.Cells(i, 1)
                End With
                firstAddress = Foundrng.Address
                Do
                    With TargetSht
                        iLastRowTargetSht = iLastRowTargetSht + 1
                        .Cells(iLastRowTargetSht, 1) = Foundrng.Offset(0, -1)
                    End With
                    Set Foundrng = .Columns(2).FindNext(Foundrng)
                Loop Until Foundrng.Address = firstAddress
            End If
        End With
    Next i
    With TargetSht
        .Rows("1:2").Delete
        .Columns(2).AutoFit
    End With
    MsgBox "Кино закончилось", 64, ""
End Sub
[/vba]

Автор - evfron
Дата добавления - 14.11.2017 в 13:18
evfron Дата: Вторник, 14.11.2017, 13:33 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
К сообщению приложен файл: post_61724.xls (82.0 Kb)


Сообщение отредактировал evfron - Вторник, 14.11.2017, 13:33
 
Ответить
СообщениеРешил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.

Автор - evfron
Дата добавления - 14.11.2017 в 13:33
evfron Дата: Вторник, 14.11.2017, 13:48 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
Разобрался вроде бы, если в столбце А листа list указан просто город или указано так же как на листе sourse, а именно например Тихорецк=Тихорецкий и Тихорецкий=ЛТЦ Тихорецкий то все выставляется на лист target, но Тихорецкий не равен Тихорецк и в таком случае копирование не производится, отсюда вопрос где в коде можно вставить строчку что бы выбирались допустим первые 5-7 символов до первого пробела в поле?


Сообщение отредактировал evfron - Вторник, 14.11.2017, 14:21
 
Ответить
Сообщение
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
Разобрался вроде бы, если в столбце А листа list указан просто город или указано так же как на листе sourse, а именно например Тихорецк=Тихорецкий и Тихорецкий=ЛТЦ Тихорецкий то все выставляется на лист target, но Тихорецкий не равен Тихорецк и в таком случае копирование не производится, отсюда вопрос где в коде можно вставить строчку что бы выбирались допустим первые 5-7 символов до первого пробела в поле?

Автор - evfron
Дата добавления - 14.11.2017 в 13:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматический поиск и вставка (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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