Дорогие ребята, помогите разобраться) у меня есть активная книга1, в ней вызывается макрос, выбираем папку где хранятся ексель файлы, открываем по одной(программно), и берем построчно из открытой книги2 листа1 сравниваем столбец Е со столбцом Е в активной книге1 листа2(этот лист изначально пустой), если не равны то копируем всю строчку и вставляем в активную книгу1 на лист2 копировать в дальнейшем друг под друга т.е. берем 2ую строку из кн2 смотрим столбец Е там стоит 245, сравниваем это значение со столбцом Е кн1, там пусто, он не равны, вставляем всю строчку в лист2 кн1, потом другую строчку берем в кн2 сравниваем начиная с первой строчки столбца Е кн1, не равны, копируем в след пустую строчку, 3яя строка кн2 сравниваем начиная с первой строчки, не равны, копируем и тд пробовала так...не получаться((( [vba]
Код
Sub Вывод2() Dim sFolder As String Dim sFiles As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) Workbooks("Книга1").Activate End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> ""
For i = 2 To r_ ' тут ругается If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> ActiveWorkbook.Sheets(2).Range("E" & i).Value Then ThisWorkbook.Worksheets(1).Rows(i).Copy ActiveWorkbook.Worksheets(2).Cells(i) End If Next i End sub
[/vba]
Дорогие ребята, помогите разобраться) у меня есть активная книга1, в ней вызывается макрос, выбираем папку где хранятся ексель файлы, открываем по одной(программно), и берем построчно из открытой книги2 листа1 сравниваем столбец Е со столбцом Е в активной книге1 листа2(этот лист изначально пустой), если не равны то копируем всю строчку и вставляем в активную книгу1 на лист2 копировать в дальнейшем друг под друга т.е. берем 2ую строку из кн2 смотрим столбец Е там стоит 245, сравниваем это значение со столбцом Е кн1, там пусто, он не равны, вставляем всю строчку в лист2 кн1, потом другую строчку берем в кн2 сравниваем начиная с первой строчки столбца Е кн1, не равны, копируем в след пустую строчку, 3яя строка кн2 сравниваем начиная с первой строчки, не равны, копируем и тд пробовала так...не получаться((( [vba]
Код
Sub Вывод2() Dim sFolder As String Dim sFiles As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) Workbooks("Книга1").Activate End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> ""
For i = 2 To r_ ' тут ругается If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> ActiveWorkbook.Sheets(2).Range("E" & i).Value Then ThisWorkbook.Worksheets(1).Rows(i).Copy ActiveWorkbook.Worksheets(2).Cells(i) End If Next i End sub
Sub Вывод2() Dim sFolder As String Dim sFiles As String r_ = ThisWorkbook.Range("B" & ThisWorkbook.Rows.Count).End(xlUp).Row With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) ' Workbooks("Книга1").Activate End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" ' Workbooks.Open sFolder & sFiles ' Worksheets("Лист1").Activate ' r_ = Range("B" & Rows.Count).End(xlUp).Row With Workbooks.Open(sFolder & sFiles).Sheets(2) For i = 2 To r_ ' тут ругается ' If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> ActiveWorkbook.Sheets(2).Range("E" & i).Value Then ' ThisWorkbook.Worksheets(1).Rows(i).Copy ActiveWorkbook.Worksheets(2).Cells(i) If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> .Range("E" & i).Value Then ThisWorkbook.Worksheets(1).Rows(i).Copy .Cells(i, "A") End If Next i End With sFiles = Dir Loop End Sub
[/vba]
[vba]
Код
Sub Вывод2() Dim sFolder As String Dim sFiles As String r_ = ThisWorkbook.Range("B" & ThisWorkbook.Rows.Count).End(xlUp).Row With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub sFolder = .SelectedItems(1) ' Workbooks("Книга1").Activate End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) Application.ScreenUpdating = False sFiles = Dir(sFolder & "*.xls*") Do While sFiles <> "" ' Workbooks.Open sFolder & sFiles ' Worksheets("Лист1").Activate ' r_ = Range("B" & Rows.Count).End(xlUp).Row With Workbooks.Open(sFolder & sFiles).Sheets(2) For i = 2 To r_ ' тут ругается ' If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> ActiveWorkbook.Sheets(2).Range("E" & i).Value Then ' ThisWorkbook.Worksheets(1).Rows(i).Copy ActiveWorkbook.Worksheets(2).Cells(i) If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> .Range("E" & i).Value Then ThisWorkbook.Worksheets(1).Rows(i).Copy .Cells(i, "A") End If Next i End With sFiles = Dir Loop End Sub
1). Добавить закрывающий Loop к циклу Do While, это критично. Иначе цикла не будет. 2). Добавить перед закрытием цикла sFiles = Dir, чтобы макрос переходил к следующему файлу. Иначе на одном и том же топтаться будет. 3). После цикла в конце добавить Application.ScreenUpdating = True. Это не критично, скорее эстетика - если выключаешь обновление экрана - будь добр(а) его потом вернуть. 4). В Вашем макросе отсутствует поиск и перебор уже заполненных строк в ThisWorkBook'e.
Klara, здравствуйте.
Из очевидного Вашему макросу требуется:
1). Добавить закрывающий Loop к циклу Do While, это критично. Иначе цикла не будет. 2). Добавить перед закрытием цикла sFiles = Dir, чтобы макрос переходил к следующему файлу. Иначе на одном и том же топтаться будет. 3). После цикла в конце добавить Application.ScreenUpdating = True. Это не критично, скорее эстетика - если выключаешь обновление экрана - будь добр(а) его потом вернуть. 4). В Вашем макросе отсутствует поиск и перебор уже заполненных строк в ThisWorkBook'e.Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
Копирует туда, куда в и пытались - на второй лист открываемой книги. Повторное открытие я прозевал, да и у вас его не было. По всему остальному, вам еще вчера Дмитрий ответил
Цитата
Что именно надо сравнить и по какому принципу - тоже неясно. Вот когда распишите нормально, что и с чем и как сравнивать - тогда можно будет попробовать Вам помочь. А так...
Копирует туда, куда в и пытались - на второй лист открываемой книги. Повторное открытие я прозевал, да и у вас его не было. По всему остальному, вам еще вчера Дмитрий ответил
Цитата
Что именно надо сравнить и по какому принципу - тоже неясно. Вот когда распишите нормально, что и с чем и как сравнивать - тогда можно будет попробовать Вам помочь. А так...
1),2),3) это понятно)))это просто начальная вырезка из кода) 4)ThisWorkBook это имеется ввиду та самая книга, которую мы открываем, т.е. поиск непустых строк?если непустых, то по критериям [vba]
Код
If Range("B" & i).Value <> "" Then If Range("E" & i) <> "" Then If IsDate(Range("D" & i)) Then
End If End If End If
[/vba]
1),2),3) это понятно)))это просто начальная вырезка из кода) 4)ThisWorkBook это имеется ввиду та самая книга, которую мы открываем, т.е. поиск непустых строк?если непустых, то по критериям [vba]
Код
If Range("B" & i).Value <> "" Then If Range("E" & i) <> "" Then If IsDate(Range("D" & i)) Then
которую открыл через диалоговое окно)) книга1(как её называла активная)-это как раз куда надо копировать книга2(открытая) - откуда надо копировать
которую открыл через диалоговое окно)) книга1(как её называла активная)-это как раз куда надо копировать книга2(открытая) - откуда надо копировать Klara
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
