VBA-下标超出范围错误

Question

我试图编写一个宏来执行以下操作：

1. 提示用户打开文件，然后向文件添加新的“不匹配”表
2. 找到“ Cust Bill To ID”和“ SAP CMF＃”的列名，并将这两列下面的数据存储到2个不同的数组[BTID（）＆CMF（）]。
3. 如果BTID（i）不等于CMF（i），则复制整个行并将其粘贴到不匹配表中。

但是，具有超出范围的预订错误和不匹配表的阵列仅具有与原始表相同的列名（数据丢失）。

结果：

码：

Sub Mismatch()

Dim sht As Worksheet
Dim authSht As Worksheet ' Renamed this variable
Dim misSht As Worksheet ' Added a worksheet variable
Dim i As Integer
Dim k As Integer
Dim last As Integer
Dim BTID() As String
Dim CMF() As String
Dim rng1 As Range ' Added this variable
Dim rng2 As Range ' Added this variable


''OPEN FILE
sFileName = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx;*.xlsm;*.xla;*.xlam),*.xls;*.xlsx;*.xlsm;*.xla;*.xlam, All Files (*.*), *.*", 1, "Select Authorization Issued Report File")
If sFileName = "False" Then Exit Sub

Application.DisplayAlerts = False
Set auth = Workbooks.Open(sFileName, UpdateLinks:=xlUpdateLinksNever)

'add new sheet
Set sht = Sheets.Add
sht.Name = "Mismatch"

Sheets("Mismatch").Select
With ActiveWorkbook.Sheets("Mismatch").Tab
    .Color = 255
    .TintAndShade = 0
End With


Set authSht = Worksheets("Authorizations Issued")
Set misSht = Worksheets("Mismatch")


''find Mismatch
authSht.Range("A2:BT2").Copy Destination:=misSht.Range("A1")

    last = ActiveSheet.UsedRange.Rows.Count
    'col = ActiveSheet.End(xlToLeft).Column
    Set rng1 = authSht.Range("A2:BH2")
    Set rng2 = rng1


    For Each c In rng1.Cells
        If c.Value = "Cust Bill To ID" Then Set rng1 = c
    Next c
    For Each c In rng2.Cells
        If c.Value = "SAP CMF#" Then Set rng2 = c
    Next c

    Dim l As Integer
    l = 2
    ReDim BTID(2 To l)
    ReDim CMF(2 To l)

    For i = 2 To last
        BTID(i) = rng1.Offset(i, 0).Value
        CMF(i) = rng2.Offset(i, 0).Value
        If i < last Then
            ReDim Preserve BTID(1 To i + 1)
            ReDim Preserve CMF(1 To i + 1)
        End If
    Next

    For k = 2 To last
        If BTID(k) = CMF(k) Then
            authSht.Range("A" & k & ":BH" & k).Copy Destination:=misSht.Range("A" & l)
            l = l + 1

        Else: l = l

        End If
    Next


misSht.UsedRange.EntireColumn.AutoFit



End Sub

而且我意识到下面的代码在for循环中不起作用。

 authSht.Range("A" & k & ":BH" & k).Copy Destination:=misSht.Range("A" & l)

此代码有什么问题？

Answer 1

我非常确信您的问题是关于不完全限定范围引用，而是依赖于隐式ActiveSheet （和ActiveWorkbook ）

您最后的选择是

Sheets("Mismatch").Select

这将激活仅在行1中放置标题的全新工作表，然后运行

last = ActiveSheet.UsedRange.Rows.Count

因此将last设置为1 ，这样您随后的For i = 2 To last循环就不会运行任何一条语句，从而使您在“ Mismatch表中处于空荡荡的状态

对于这种情况，最直接的修复方法是：

authSht.Activate

就在之前：

last = ActiveSheet.UsedRange.Rows.Count

但真正的补丁将使用完全限定的范围引用，如下所示：

替代：

''find Mismatch
authSht.Range("A2:BT2").Copy Destination:=misSht.Range("A1")

    last = ActiveSheet.UsedRange.Rows.Count
    'col = ActiveSheet.End(xlToLeft).Column
    Set rng1 = authSht.Range("A2:BH2")
    Set rng2 = rng1

使用以下代码：

With authSht
''find Mismatch
    .Range("A2:BT2").Copy Destination:=misSht.Range("A1")

    last = .UsedRange.Rows.Count
    'col = ActiveSheet.End(xlToLeft).Column
    Set rng1 = .Range("A2:BH2")
End With
Set rng2 = rng1 '<--| what0s this for? you can stick to 'rng1'