VBA – 下标超出范围错误

我正在尝试编写一个macros来执行以下操作：

1. 提示用户打开他们的文件，然后添加新的“不匹配”表到文件
2. find“Cust Bill To ID”和“SAP CMF＃”的列名，并将这两列下面的数据存储到两个不同的数组[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 ）

你最后一张表select

 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'