Question

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

提示用户打开他们的文件，然后添加新的＆＃34; Mismatch＆＃34;表单文件
找到＆＃34; Cust Bill To ID＆＃34;的列名。＆安培; ＆＃34; SAP CMF＃＆＃34;和商店这两列下面的数据为2个不同的数组[BTID（）＆amp; CMF（）]。
如果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循环都不会运行单个语句，而在{{{}}中留下空手（好吧，单元格） {1}}表

这种情况的最直接修复将放置：

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

VBA - 下标超出范围错误

1 个答案: