Доброго времени суток! Возник вопрос автоматизации ручной работы, а именно из 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]
Доброго времени суток! Возник вопрос автоматизации ручной работы, а именно из 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
]Доброго времени суток! На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?
]Доброго времени суток! На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?InExSu
Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
]Доброго времени суток! На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?
Ищем совпадение на листе LTC во втором столбце и если нашли то скопировать найденное значение из двух столбцов и вставить в лист info в столбцы С D. В файле во вкладке Лист2 написал как я это вижу
]Доброго времени суток! На листе Info, в колонке 1 есть Горячий Ключ г., находим на листе LTC Горячий Ключ без "г." их там 4 штуки с разными ЛТЦ, и что дальше?
Ищем совпадение на листе LTC во втором столбце и если нашли то скопировать найденное значение из двух столбцов и вставить в лист info в столбцы С D. В файле во вкладке Лист2 написал как я это вижуevfron
Из проделанной вами работы результат на лицо, но хочется не растягивать формулу на н-ное количество строк, а заполнять по нажатию кнопки выполнения макроса, так как выгрузка бывает разной. И судя по формуле он ищет точное совпадение, и если не находит то соответственно ничего не вставляет. Да я понимаю, что это причина не универсальности поискового запроса, от сюда в макросе можно будет указать критерий поиска, например добавлять к поисковому слову пробел в начале, и искать по первым 3-5 буквам.
Из проделанной вами работы результат на лицо, но хочется не растягивать формулу на н-ное количество строк, а заполнять по нажатию кнопки выполнения макроса, так как выгрузка бывает разной. И судя по формуле он ищет точное совпадение, и если не находит то соответственно ничего не вставляет. Да я понимаю, что это причина не универсальности поискового запроса, от сюда в макросе можно будет указать критерий поиска, например добавлять к поисковому слову пробел в начале, и искать по первым 3-5 буквам.evfron
Так и не смог ничего дельного написать своими силами, поэтому на просторах сети нашел подобный пример и адаптировал его под себя, но не могу понять следующее:
В примере было так, но на листе 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]
Так и не смог ничего дельного написать своими силами, поэтому на просторах сети нашел подобный пример и адаптировал его под себя, но не могу понять следующее:
В примере было так, но на листе 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
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.evfron
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
Разобрался вроде бы, если в столбце А листа list указан просто город или указано так же как на листе sourse, а именно например Тихорецк=Тихорецкий и Тихорецкий=ЛТЦ Тихорецкий то все выставляется на лист target, но Тихорецкий не равен Тихорецк и в таком случае копирование не производится, отсюда вопрос где в коде можно вставить строчку что бы выбирались допустим первые 5-7 символов до первого пробела в поле?
Решил немного упростить задачу и в файл найденного примера вставить так как я вижу отработку в поставленной задаче, и оказалось что макрос сработал только на цифры в файле, а мои буквенные значения не искал, от сюда вопрос в чем может быть проблема? по коду вроде нигде не указывается что будут использованы только цифры.
Разобрался вроде бы, если в столбце А листа list указан просто город или указано так же как на листе sourse, а именно например Тихорецк=Тихорецкий и Тихорецкий=ЛТЦ Тихорецкий то все выставляется на лист target, но Тихорецкий не равен Тихорецк и в таком случае копирование не производится, отсюда вопрос где в коде можно вставить строчку что бы выбирались допустим первые 5-7 символов до первого пробела в поле?evfron
Сообщение отредактировал evfron - Вторник, 14.11.2017, 14:21