Excel VBA在完成之前正在停止

我有个问题

我在同一工作簿的不同工作表上有两个数据集。 两个数据集中的第一列都是标识符。在Sheet1中，我有我的数据集，并希望用Sheet2中的数据填充它（其中也包含我不想使用的数据（行+列））

我有一个VBA正在工作，但它在完成之前就停止了。 例如，我在Sheet2中有1598行，但在567行之后它就停止工作了

Sub Test()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    Set Source = ActiveWorkbook.Worksheets("Sheet2")
    Set Target = ActiveWorkbook.Worksheets("Sheet1")

    j = 2    
    For Each c In Source.Range("A2", Source.Range("A" & Source.Cells(Source.Rows.Count, "A").End(xlUp).Row))
        If c = Target.Cells(j, 1).Value Then
           Source.Range("D" & c.Row & ":AS" & c.Row).Copy Target.Cells(j, 26) 
           j = j + 1
        End If
    Next c
    MsgBox "Done"
End Sub

有人能帮我看看代码是否有明显的错误吗？我已经在较小的数据集上试用过了，然后它就完美了。 如果需要更多信息或您有其他建议，请询问/告诉：D

谢谢！

VBA解决方案 尝试以下操作，它使用来正确匹配列A的值，无论它们的顺序如何

它循环遍历目标中的所有行，并尝试在源中查找匹配行。如果找到匹配行，则将其复制到目标中

Option Explicit

Public Sub Test()
    Dim Source As Worksheet
    Set Source = ThisWorkbook.Worksheets("Sheet2")

    Dim Target As Worksheet
    Set Target = ThisWorkbook.Worksheets("Sheet1")


    Dim LastRowTarget As Long
    LastRowTarget = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row

    Dim tRow As Long
    For tRow = 2 To LastRowTarget
        Dim sRowMatch As Double
        sRowMatch = 0 'reset match row
        On Error Resume Next 'ignore if next line throws error
        sRowMatch = Application.WorksheetFunction.Match(Target.Cells(tRow, 1).Value, Source.Columns("A"), 0)
        On Error GoTo 0 're-enable error reporting

        If sRowMatch <> 0 Then 'if matching does not find anything it will be 0 so <>0 means something was found to copy
            Source.Range("D" & sRowMatch & ":AS" & sRowMatch).Copy Target.Cells(tRow, 26)
        End If
    Next tRow

    MsgBox "Done"
End Sub

选项显式
公共子测试（）
将源设置为工作表
Set Source=此工作簿。工作表（“Sheet2”）
将目标变暗为工作表
设置目标=此工作簿。工作表（“表1”）
将最后一行目标变暗为长
LastRowTarget=Target.Cells（Target.Rows.Count，“A”）.End（xlUp）.Row
昏昏欲睡
对于tRow=2到LastRowTarget
暗sRowMatch为双色
sRowMatch=0'重置匹配行
错误时继续下一行“忽略下一行引发的错误”
sRowMatch=Application.WorksheetFunction.Match（Target.Cells（tRow，1）.Value，Source.Columns（“A”），0）
错误转到0时，重新启用错误报告
如果sRowMatch 0，则“如果匹配未找到任何内容，则它将为0，因此0表示找到要复制的内容
Source.Range（“D”&sRowMatch&“：AS”&sRowMatch）。复制Target.Cells（tRow，26）
如果结束
下一步
MsgBox“完成”
端接头

配方溶液 请注意，不需要VBA，这实际上也可以仅用公式来解决。可以是

VLOOKUP

公式，也可以是

INDEX

和

MATCH

公式的组合

---

因此，在Sheet1单元格Z2中写入

=INDEX（Sheet2！D:D，MATCH（$A2，Sheet2！$A:$A，0））

并将其向下和向右拉。

请指定“567行之后它已经停止工作”的确切含义？您是否在最后得到消息框？将其更改为

MsgBox“Done c=“&c&”j=”&j

并告诉我们

c

和

j

的输出。还包括

Debug.Print Source.Cells（Source.Rows.Count，“A”）的值。End（xlUp）。Row

谢谢，我将尝试一下，看看它说了什么。使用“它停止工作…”，我只得到表1上前567行的结果，尽管我知道表之间有更多匹配项：）请注意，此算法仅比较源A2和目标A2，如果不匹配，则将比较源A3和目标A2，依此类推，因此您的行计数与每一个不匹配的行不同。您可能需要使用

Application.WorksheetFunction.Match

来获得正确的加工。建议：

Dim j As Long

（非整数）这不会解决您的问题，但行变量应始终为

Long

侧注：不要在VBA中使用

Integer

类型，它们只是

Long

集群，并且从−32768到32767，所以它可能会给你错误。谢谢！这工作完美！通常我也会使用这些公式中的一个，这只是一个非常公式化的工作簿，很多人都在使用它，所以我正在尝试制作按钮，只需单击按钮，就可以以最“简单”和最轻松的方式获得我们想要的结果。。