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'