Question

我有两张（当月和上个月），每行有大约4000个不同的帐号和详细信息。比较帐号，如果“当前月”表中的帐号不在“上个月”表中，则会以黄色突出显示。本部分适用于以下代码。

我无法工作的那部分。如果帐号匹配，请将上一个月工作表中匹配帐号的列H到N复制到当前月份表中的H到N列。当我试图定义LastRow变量时，我得到运行时错误9 - 下标超出范围，但我也不确定该错误下面的循环是否也能正常工作。

这是代码;

Sub RangeCompare()
'   The range Previous Month is the baseline so if the range Current Month has a value that is not in the Previous Month it is highlighted
'   If the Previous Month range has a value that is in Current Month then copy Previous Months columns H to N to Current Month columns H to N
'   ACCOUNT NUMBERS SELECTED MUST BE IN COLUMN A, IF NOT THE COPY/PASTE WILL NOT WORK!

'   Warning to the end user that column A must contain the Account Numbers or this will cause the copy part of the macro to fail
    MsgBox "!! Column A must contain the Account Numbers !!"

    Dim PrevMonth As Range, CurMonth As Range, c As Range, TempVal As Range
    Dim CurSheet As String, PrevSheet As String
    Dim LastRow1 As Long

    Set PrevMonth = Application.InputBox("Select appropriate sheet and all accounts:", Title:="Select Previous Months Accounts", Type:=8)
'    next variable needed so VBA knows what the Previous worksheet name is, this is needed for the copying section of the macro
    PrevSheet = ActiveSheet.Name
    If PrevMonth Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If

    Set CurMonth = Application.InputBox("Select appropriate sheet and all accounts:", Title:="Select Current Months Accounts", Type:=8)
    ' next variable needed so VBA knows what the Current worksheet name is, this is needed for the copying section of the macro
    CurSheet = ActiveSheet.Name
    LastRow2 = Selection.Rows.Count
    If CurMonth Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If


'   Highlight cells not in PrevMonth to yellow Colorindex = 6
'   This loop works :-)
    For Each c In CurMonth.Cells
        If Application.WorksheetFunction.CountIf(PrevMonth, c.Value) = 0 Then
            c.Interior.ColorIndex = 6
        End If
    Next c

'    Copy columns H:N from previous month sheet to H:N in current months sheet if Account numbers match

   LastRow1 = Sheets("PrevSheet").Range("PrevMonth").Rows.Count
'  The above gives runtime error 9 - subscript out of range
'  I don't know if the loop below will work as I can't define LastRow1 due to the error above.
    For sRow = 2 To LastRow1
        TempVal = Sheets(PrevSheet).Range(sRow, "H").Range(sRow, "N")
             If Sheets("CurSheet").Cells(sRow, 1).Text = Sheets("PrevSheet").Cells(sRow, 1).Text Then
                    Sheets(CurSheet).Range(sRow, "H").Range(sRow, "N") = TempVal
             End If
    Next sRow

End Sub

Answer 1

更新以便在VBA中使用_headerSave(header_name).header_name;查找帐号，因为工作表名称的名称将会更改（我假设）：

INDEX/MATCH

比较不同工作表上的两个范围以及值是否与复制范围匹配

1 个答案: