Доброго времени суток! Уважаемые форумчане, прошу Вас помочь в решении задачи. Есть две (или более) книги. Необходимо взять значение из 1 книги и поискать его во 2-ой. Если значение будет найдено, то скопировать рядом находящиеся данные из 2-ой книги в 1-ую. Я написал код с помощью циклов. Он работоспособен. Но поскольку 1 и 2 книги содержат очень много строк( десятки тысяч), работа макроса растягивается на часы. Может быть сможете посоветовать как исполнить данный код с соблюдением критериев поиска, но без использования циклов? [vba]
Код
Sub fsdf() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim eks As Workbook Set eks = Workbooks.Open("C:\КП\ЕКС\1-0001.xlsx") Dim listeks As Excel.Worksheet Set listeks = eks.Worksheets("1-0001") Konez_eks = listeks.Cells(Rows.Count, 1).End(xlUp).Row Dim fns013 As Workbook Set fns013 = Workbooks.Open("C:\КП\ФНС\013.xls") Dim listfns013 As Excel.Worksheet Set listfns013 = fns013.Worksheets("013") listfns013.Cells.MergeCells = False Konez_fns013 = listfns013.Cells(Rows.Count, 2).End(xlUp).Row For a = 2 To Konez_eks For b = 2 To Konez_fns013
If (listeks.Cells(a, 22) = "013" And listeks.Cells(a, 3) Like "*" & "ЭДО" And listeks.Cells(a, 5) = listfns013.Cells(b, 2) And listeks.Cells(a, 11) = listfns013.Cells(b - 1, 2 - 1)) _ Or (listeks.Cells(a, 22) = "013" And listeks.Cells(a, 3) Like "*" & "Бумага" And listeks.Cells(a, 21) = listfns013.Cells(b, 2) And listeks.Cells(a, 11) = listfns013.Cells(b - 1, 2 - 1)) _ Then listeks.Cells(a, 23) = listfns013.Cells(b - 1, 2 - 1) 'счет listeks.Cells(a, 24) = listfns013.Cells(b, 2) '29000 listeks.Cells(a, 25) = listfns013.Cells(b, 2 + 1) 'Сообщение банка listeks.Cells(a, 26) = listfns013.Cells(b - 1, 2 + 2) 'Квитанция End If Next b Next a Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]
Доброго времени суток! Уважаемые форумчане, прошу Вас помочь в решении задачи. Есть две (или более) книги. Необходимо взять значение из 1 книги и поискать его во 2-ой. Если значение будет найдено, то скопировать рядом находящиеся данные из 2-ой книги в 1-ую. Я написал код с помощью циклов. Он работоспособен. Но поскольку 1 и 2 книги содержат очень много строк( десятки тысяч), работа макроса растягивается на часы. Может быть сможете посоветовать как исполнить данный код с соблюдением критериев поиска, но без использования циклов? [vba]
Код
Sub fsdf() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim eks As Workbook Set eks = Workbooks.Open("C:\КП\ЕКС\1-0001.xlsx") Dim listeks As Excel.Worksheet Set listeks = eks.Worksheets("1-0001") Konez_eks = listeks.Cells(Rows.Count, 1).End(xlUp).Row Dim fns013 As Workbook Set fns013 = Workbooks.Open("C:\КП\ФНС\013.xls") Dim listfns013 As Excel.Worksheet Set listfns013 = fns013.Worksheets("013") listfns013.Cells.MergeCells = False Konez_fns013 = listfns013.Cells(Rows.Count, 2).End(xlUp).Row For a = 2 To Konez_eks For b = 2 To Konez_fns013
If (listeks.Cells(a, 22) = "013" And listeks.Cells(a, 3) Like "*" & "ЭДО" And listeks.Cells(a, 5) = listfns013.Cells(b, 2) And listeks.Cells(a, 11) = listfns013.Cells(b - 1, 2 - 1)) _ Or (listeks.Cells(a, 22) = "013" And listeks.Cells(a, 3) Like "*" & "Бумага" And listeks.Cells(a, 21) = listfns013.Cells(b, 2) And listeks.Cells(a, 11) = listfns013.Cells(b - 1, 2 - 1)) _ Then listeks.Cells(a, 23) = listfns013.Cells(b - 1, 2 - 1) 'счет listeks.Cells(a, 24) = listfns013.Cells(b, 2) '29000 listeks.Cells(a, 25) = listfns013.Cells(b, 2 + 1) 'Сообщение банка listeks.Cells(a, 26) = listfns013.Cells(b - 1, 2 + 2) 'Квитанция End If Next b Next a Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Не вникая в код можно сразу предложить загружать данные с листов в массивы и далее с ними работать. А в конце выгрузить массив обратно на лист. Обычно это в разы ускоряет обработку (на больших объемах)
Не вникая в код можно сразу предложить загружать данные с листов в массивы и далее с ними работать. А в конце выгрузить массив обратно на лист. Обычно это в разы ускоряет обработку (на больших объемах)Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Udik, Спасибо за ответ! Скажите, а предложенный вами способ подойдет для таких листов? И на каком этапе их сталкивать я не совсем понял. Извините за некомпетентность.
Udik, Спасибо за ответ! Скажите, а предложенный вами способ подойдет для таких листов? И на каком этапе их сталкивать я не совсем понял. Извините за некомпетентность.Blasster88
Что бы было понятней вкладываю рабочую версию макроса с книгами. если кто то сможет помочь поправить код что бы работало быстрее, то буду очень благодарен. Так как сам не очень понял к использовать массив в моей ситуации.
Что бы было понятней вкладываю рабочую версию макроса с книгами. если кто то сможет помочь поправить код что бы работало быстрее, то буду очень благодарен. Так как сам не очень понял к использовать массив в моей ситуации.Blasster88
Скажите, а предложенный вами способ подойдет для таких листов?
Данные с такого листа загрузятся и даже выгрузятся, но вот форматирования на новых записях не будет. В общем если такой лист загрузить, потом что-то изменить в "ячейках" и выгрузить, то все нормально. А если какие-то махинации с размерностью массива делать, то могут проблемы возникнуть. Да, если на листах есть формулы, так сделать не получится, т.к. в массив запишутся значения.
Скажите, а предложенный вами способ подойдет для таких листов?
Данные с такого листа загрузятся и даже выгрузятся, но вот форматирования на новых записях не будет. В общем если такой лист загрузить, потом что-то изменить в "ячейках" и выгрузить, то все нормально. А если какие-то махинации с размерностью массива делать, то могут проблемы возникнуть. Да, если на листах есть формулы, так сделать не получится, т.к. в массив запишутся значения.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Сообщение отредактировал Udik - Суббота, 16.09.2017, 16:11
Вот сделал. Только не понял почему ссылки идут на столбцы больше 22. На листе последний столбец 22, я под этот размер массив делал. Сейчас наверняка ошибка выскочит о выходе за границы массива. [vba]
Код
Sub fsdf() Dim arrTbl1, arrTbl2 Dim rng1 As Range Application.DisplayAlerts = False 'Application.Calculation = xlCalculationManual Application.ScreenUpdating = False st = Timer
Dim eks As Workbook Set eks = Workbooks.Open("C:\Users\Александр\Desktop\КП\ЕКС\1-0002.xlsx") Dim listeks As Excel.Worksheet Set listeks = eks.Worksheets("1-0001")
Konez_eks = listeks.Cells(Rows.Count, 1).End(xlUp).Row Set rng1 = listeks.Range(.Cells(1, 1), .Cells(Konez_eks, 22)) arrTbl1 = rng1.Value '' загружаем лист из файла 1-0002.xlsx
Dim fns013 As Workbook Set fns013 = Workbooks.Open("C:\Users\Александр\Desktop\КП\ФНС\013.xls") Dim listfns013 As Excel.Worksheet Set listfns013 = fns013.Worksheets("013") listfns013.Cells.MergeCells = False
Konez_fns013 = listfns013.Cells(Rows.Count, 2).End(xlUp).Row Set rng1 = listeks.Range(.Cells(1, 1), .Cells(Konez_fns013, 5)) arrTbl2 = rng1.Value ''загружаем лист из файла 13.xlsx
For a = 2 To Konez_eks If listeks.Cells(a, 22) = "013" Then For b = 2 To Konez_fns013 If (arrTbl1(a, 3) Like "*" & "ЭДО" And arrTbl1(a, 5) = arrTbl2(b, 2) And arrTbl1(a, 11) = arrTbl2(b - 1, 2 - 1)) _ Or (arrTbl1(a, 3) Like "*" & "Бумага" And arrTbl1(a, 21) = arrTbl2(b, 2) And arrTbl1(a, 11) = arrTbl2(b - 1, 2 - 1)) _ Then arrTbl1(a, 23) = arrTbl2(b - 1, 2 - 1) 'счет arrTbl1(a, 24) = arrTbl2(b, 2) '29000 arrTbl1(a, 25) = arrTbl2(b, 2 + 1) 'Сообщение банка arrTbl1(a, 26) = arrTbl2(b - 1, 2 + 2) 'Квитанция End If Next b End If Next a
listeks.Range("A1").Resize(UBound(arrTbl1, 1), UBound(arrTbl1, 2)) = arrTbl1 '' выгружаем на лист 1-й массив.
Application.DisplayAlerts = True 'Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
[/vba]
Вот сделал. Только не понял почему ссылки идут на столбцы больше 22. На листе последний столбец 22, я под этот размер массив делал. Сейчас наверняка ошибка выскочит о выходе за границы массива. [vba]
Код
Sub fsdf() Dim arrTbl1, arrTbl2 Dim rng1 As Range Application.DisplayAlerts = False 'Application.Calculation = xlCalculationManual Application.ScreenUpdating = False st = Timer
Dim eks As Workbook Set eks = Workbooks.Open("C:\Users\Александр\Desktop\КП\ЕКС\1-0002.xlsx") Dim listeks As Excel.Worksheet Set listeks = eks.Worksheets("1-0001")
Konez_eks = listeks.Cells(Rows.Count, 1).End(xlUp).Row Set rng1 = listeks.Range(.Cells(1, 1), .Cells(Konez_eks, 22)) arrTbl1 = rng1.Value '' загружаем лист из файла 1-0002.xlsx
Dim fns013 As Workbook Set fns013 = Workbooks.Open("C:\Users\Александр\Desktop\КП\ФНС\013.xls") Dim listfns013 As Excel.Worksheet Set listfns013 = fns013.Worksheets("013") listfns013.Cells.MergeCells = False
Konez_fns013 = listfns013.Cells(Rows.Count, 2).End(xlUp).Row Set rng1 = listeks.Range(.Cells(1, 1), .Cells(Konez_fns013, 5)) arrTbl2 = rng1.Value ''загружаем лист из файла 13.xlsx
For a = 2 To Konez_eks If listeks.Cells(a, 22) = "013" Then For b = 2 To Konez_fns013 If (arrTbl1(a, 3) Like "*" & "ЭДО" And arrTbl1(a, 5) = arrTbl2(b, 2) And arrTbl1(a, 11) = arrTbl2(b - 1, 2 - 1)) _ Or (arrTbl1(a, 3) Like "*" & "Бумага" And arrTbl1(a, 21) = arrTbl2(b, 2) And arrTbl1(a, 11) = arrTbl2(b - 1, 2 - 1)) _ Then arrTbl1(a, 23) = arrTbl2(b - 1, 2 - 1) 'счет arrTbl1(a, 24) = arrTbl2(b, 2) '29000 arrTbl1(a, 25) = arrTbl2(b, 2 + 1) 'Сообщение банка arrTbl1(a, 26) = arrTbl2(b - 1, 2 + 2) 'Квитанция End If Next b End If Next a
listeks.Range("A1").Resize(UBound(arrTbl1, 1), UBound(arrTbl1, 2)) = arrTbl1 '' выгружаем на лист 1-й массив.
Udik, Спасибо вам большое, сейчас буду пробовать! А ссылки идут потому что я как раз и копирую данные из второй книги в первые свободные столбцы, т.е. добавляю информацию - последний столбец у нас 22, соответственно в 23, 24...я добавляю данные из книги два
Udik, Спасибо вам большое, сейчас буду пробовать! А ссылки идут потому что я как раз и копирую данные из второй книги в первые свободные столбцы, т.е. добавляю информацию - последний столбец у нас 22, соответственно в 23, 24...я добавляю данные из книги дваBlasster88
With listeks Set rng1 = .Range(.Cells(1, 1), .Cells(Konez_eks, 28)) arrTbl1 = rng1.Value '' загружаем лист из файла 1-0002.xlsx End With With listfns013 Set rng1 = .Range(.Cells(1, 1), .Cells(Konez_fns013, 5)) arrTbl2 = rng1.Value ''загружаем лист из файла 13.xlsx End With
[/vba] и путь до файлов сделал относительно текущего.
Подправил. [vba]
Код
With listeks Set rng1 = .Range(.Cells(1, 1), .Cells(Konez_eks, 28)) arrTbl1 = rng1.Value '' загружаем лист из файла 1-0002.xlsx End With With listfns013 Set rng1 = .Range(.Cells(1, 1), .Cells(Konez_fns013, 5)) arrTbl2 = rng1.Value ''загружаем лист из файла 13.xlsx End With
[/vba] и путь до файлов сделал относительно текущего.Udik
Udik, Еще маленький нюанс остался. А как мне вставлять данные из массива в другом формате? у меня просто номера счетов вставляются вот так: 4,07Е+19, а если менять формат то встают вот с нулями в конце 40802810107000000000
Udik, Еще маленький нюанс остался. А как мне вставлять данные из массива в другом формате? у меня просто номера счетов вставляются вот так: 4,07Е+19, а если менять формат то встают вот с нулями в конце 40802810107000000000Blasster88
ну надо столбец со счетом форматнуть под текст, тогда будет вставлять точно как в массиве. И посмотреть что там в ячейке находится. Если сами не справитесь, заводите новую тему
ну надо столбец со счетом форматнуть под текст, тогда будет вставлять точно как в массиве. И посмотреть что там в ячейке находится. Если сами не справитесь, заводите новую тему Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Сообщение отредактировал Udik - Суббота, 16.09.2017, 19:36