Блог

Я пытаюсь импортировать строки с новыми данными из Report.xlsx файл в мой Workbook.xlsx файл, основанный на столбце X, который может содержать число или цифры, разделенные запятой. Мне нужно импортировать только те строки, которых еще нет в моей рабочей книге, с 69 ячейками, которые также могут содержать цифры и текст. Я хочу, чтобы этот макрос запускался автоматически еженедельно. Программа запускается без каких-либо проблем, она равномерно открывает и закрывает файл отчета после выполнения, но строки не импортируются.

 Sub Weekly_Report()
Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
Const NUM_COLS As Long = 69 '69 rows needed to be imported from the Report

Dim Path, Filename, wbReport As Workbook, wsReport As Worksheet, m
Dim wsData As Worksheet, next_blank_row As Long, r As Long, c As Range, rwStart As Long

Path = "C:UsersDocuments" 'path of the report
Filename = Dir(Path amp; "Report.xlsx")

Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
next_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row   1 'next blank row

Do While Filename <> ""

    Set wbReport = Workbooks.Open(Path amp; Filename) 
    Set wsReport = wbReport.Worksheets(1)          
    rwStart = IIf(HAS_HEADER, 2, 1)
    
    For r = rwStart To wsReport.Cells(Rows.Count, 1).End(xlUp).Row
        
        m = Application.Match(wsReport.Cells(r, 1).Value, wsData.Columns("X"), 0)
        If IsError(m) Then
            m = next_blank_row 'no match - use next blank row and increment
            next_blank_row = next_blank_row   1
        End If
        wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = wsReport.Cells(r, 1).Resize(1, NUM_COLS).Value
    Next r
    
    wbReport.Close False
    Filename = Dir()
Loop

End Sub
  

В качестве альтернативы для СОПОСТАВЛЕНИЯ попробуйте диапазон.Функция поиска.

 Option Explicit

Sub Weekly_Report()
    
    Const HAS_HEADER As Boolean = True 'Set true if the file has a header(Report)
    Const NUM_COLS As Long = 69 '69 rows needed to be imported from the Report
    Const FILENAME = "Report.xlsx"
    Const PATH = "C:UsersDocuments" 'path of the report
    
    Dim wbReport As Workbook, wsReport As Worksheet, wsData As Worksheet
    Dim next_blank_row As Long, iStartRow As Long, iLastRow As Long, iRow As Long
    Dim sFilename As String
        
    Set wsData = ThisWorkbook.Worksheets("Sheet1") 'for example: destination worksheet
    next_blank_row = wsData.Cells(Rows.Count, "X").End(xlUp).Row   1 'next blank row
    
    sFilename = PATH amp; FILENAME
    Debug.Print "Opening ", sFilename
    On Error Resume Next
 
    Set wbReport = Workbooks.Open(sFilename)
    On Error GoTo 0
    If wbReport Is Nothing Then
        MsgBox "Can not open " amp; sFilename, vbCritical, "ERROR"
        Exit Sub
    End If
        
    Set wsReport = wbReport.Worksheets(1)
    iStartRow = IIf(HAS_HEADER, 2, 1)
    iLastRow = wsReport.Cells(Rows.Count, 1).End(xlUp).Row
        
    Dim s As String, rng As Range, m As Long
    For iRow = iStartRow To iLastRow
        
        s = CStr(wsReport.Cells(iRow, "X").Value)
        Set rng = wsData.Columns("X").Find(s)
        
        If rng Is Nothing Then
            m = next_blank_row 'no match - use next blank row and increment
            next_blank_row = next_blank_row   1
            Debug.Print iRow, s, "New row " amp; m
        Else
            m = rng.Row
            Debug.Print iRow, s, "Match row " amp; m
        End If
        wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = wsReport.Cells(iRow, 1).Resize(1, NUM_COLS).Value
        
    Next
        
    MsgBox wsReport.Name amp; " scanned from row " amp; iStartRow amp; _
           " to " amp; iLastRow, vbInformation, sFilename
    wbReport.Close False

End Sub