Макрос для сравнения данных ячеек одной книги с другой - VBA
Формулировка задачи:
Здравствуйте!
Пожалуйста, не ругайтесь, я новенький.
У меня стоит задача автоматизации отчета по дням.
Во вложении я привел данные, с которыми нужно работать. Суть задачи такова, что нужно проверить из Книга2 каждую ячейку первого столбца со всеми ячейками первого столбца из Книга1, и если совпадет, нужно вставить данные ячейки этой же строки второго столбца в найденную строку из Книга1 того столбца, даты которых совпадают (даты прописаны в первой стоке Книга1, а в файле Книга2 в ячейку B3)
Заранее благодарен за помощь.Книга1.xlsxКнига2.xlsx
Решение задачи: «Макрос для сравнения данных ячеек одной книги с другой»
textual
Листинг программы
Option Base 1 Sub qweqwe() Dim Twb As Workbook Dim Arr, Arr2 Dim Wb As Workbook Dim Da As Date Dim s As Long, sC%, jDa% Dim FName$ Application.ScreenUpdating = False Set Twb = ThisWorkbook s = Twb.Sheets(1).Cells(1, 1).End(xlDown).Row sC = Twb.Sheets(1).Cells(1, 3).End(xlToRight).Column Arr = Range(Twb.Sheets(1).Cells(1, 1), Twb.Sheets(1).Cells(s, 1)) FName = GetFilePath(, Twb.Path) If FName = "" Then Exit Sub Set Wb = Workbooks.Open(FName) s = Wb.Sheets(1).Cells(4, 1).End(xlDown).Row Arr2 = Range(Wb.Sheets(1).Cells(5, 1), Wb.Sheets(1).Cells(s, 2)) Da = Wb.Sheets(1).Cells(3, 2) For j = 3 To sC If CDate(Twb.Sheets(1).Cells(1, j)) = Da Then jDa = j: Exit For Next j Wb.Close False For i = 3 To UBound(Arr) For j = 1 To UBound(Arr2) If Arr(i, 1) = Arr2(j, 1) Then Twb.Sheets(1).Cells(i, jDa) = Arr2(j, 2) End If Next j Next i End Sub Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _ Optional ByVal InitialPath As String = "", _ Optional ByVal FilterDescription As String = "Книги Excel", _ Optional ByVal FilterExtention As String = "*.xlsx*") As String On Error Resume Next With Application.FileDialog(msoFileDialogOpen) .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath .Filters.Clear: .Filters.Add FilterDescription, FilterExtention If .Show <> -1 Then Exit Function GetFilePath = .SelectedItems(1): PS = Application.PathSeparator End With End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д