Все же победил я его. Но может както лучше можно было его написать? или проще?
Весь код:
Весь код:
| Код |
|---|
Option Explicit
Sub Search_through_Books()
'i& — скоращенноя форма записи As Long
Dim fileItem, openedWorkBook As Workbook, lastRowOfOpenedWb&, lastColumnOfOpenedWb&
Dim SearchRange As Range, Cell As Range, i&, j&
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Выберите нужные файлы удерживая Shift или Ctrl"
.Filters.Add "Excel files", "*.xls; *.xlsx; *.xlsm", 1
.ButtonName = "Start"
If .Show = -1 Then
Application.ScreenUpdating = False
Set SearchRange = ThisWorkbook.Worksheets("Источник").Range("A2:A" & _
ThisWorkbook.Worksheets("Источник").Cells(Rows.Count, "A").End(xlUp).Row)
For Each fileItem In .SelectedItems
Set openedWorkBook = Workbooks.Open(fileItem)
lastRowOfOpenedWb = openedWorkBook.Worksheets(1).Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To lastRowOfOpenedWb
If openedWorkBook.Worksheets(1).Cells(i, "C").Text Like "*" & ThisWorkbook.Worksheets("Источник").Range("A2").Text & "*" _
And openedWorkBook.Worksheets(1).Cells(i, "D").Text <> "Дебет" _
And openedWorkBook.Worksheets(1).Cells(i, "D").Text <> "Д" Then
lastColumnOfOpenedWb = openedWorkBook.Worksheets(1).Cells(i, Columns.Count).End(xlToLeft).Column
Range(openedWorkBook.Worksheets(1).Cells(i, 1), openedWorkBook.Worksheets(1).Cells(i, lastColumnOfOpenedWb)).Copy _
ThisWorkbook.Worksheets("Результат").Range("B1").Offset(j, 0)
ThisWorkbook.Worksheets("Результат").Range("A1").Offset(j, 0).Value = openedWorkBook.Name
j = j + 1
ElseIf openedWorkBook.Worksheets(1).Cells(i, "C").Text Like "*" & ThisWorkbook.Worksheets("Источник").Range("A2").Text & "*" _
And (openedWorkBook.Worksheets(1).Cells(i, "D").Text = "Дебет" _
Or openedWorkBook.Worksheets(1).Cells(i, "D").Text = "Д") Then
lastColumnOfOpenedWb = openedWorkBook.Worksheets(1).Cells(i, Columns.Count).End(xlToLeft).Column
Range(openedWorkBook.Worksheets(1).Cells(i, 1), openedWorkBook.Worksheets(1).Cells(i, lastColumnOfOpenedWb)).Offset(-2, 0).Copy _
ThisWorkbook.Worksheets("Результат").Range("B1").Offset(j, 0)
ThisWorkbook.Worksheets("Результат").Range("A1").Offset(j, 0).Value = openedWorkBook.Name
j = j + 1
End If
Next i
openedWorkBook.Close
Set openedWorkBook = Nothing
Next fileItem
End If
End With
Application.ScreenUpdating = True
End Sub
|
Изменено: - 30.10.2023 11:48:05
