VBA在完成前将停止 [英] VBA is stopping before it is done

问题描述

我有问题...

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

I have two datasets in the same workbook on different sheets. The first column in both datasets are identifiers. In Sheet1 I have my dataset, and want to fill it with data from Sheet2 (which is also containing data (rows+Columns) that I do not want to use.

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

I have a VBA that is working, BUT, it stops before it is done. E.g. I have 1598 Rows in Sheet2, but it stops working already after 567 rows..

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

Can someone help me and see if there is something obviously wrong with the code? I have tried it on smaller datasets, and then it works perfect. If more information needed or you have some other tips, please ask/tell :D

谢谢！

推荐答案

VBA解决方案

尝试以下操作，它使用 WorksheetFunction.匹配方法，无论它们的顺序如何，都可以正确匹配A列的值.

VBA Solution

Try the following, it usese the WorksheetFunction.Match method to properly match the values of column A no matter which order they are.

它循环遍历Target中的所有行，并尝试在Source中找到匹配的行.如果找到匹配项，则会将其复制到目标中.

It loops through all rows in Target, and tries to find a matching row in Source. If a match was found it copies it into the Target.

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

公式解决方案

请注意，不需要VBA，实际上也可以仅使用公式来解决. VLOOKUP公式或INDEX和MATCH公式的组合.

Formula Solution

Note that there is no need for VBA and this could actually also solved with formulas only. Either the VLOOKUP formula or a combination of INDEX and MATCH formula.

因此，在Sheet1单元格Z2中写入=INDEX(Sheet2!D:D,MATCH($A2,Sheet2!$A:$A, 0))并将其向右下拉.

So in Sheet1 cell Z2 write =INDEX(Sheet2!D:D,MATCH($A2,Sheet2!$A:$A, 0)) and pull it down and right.

这篇关于VBA在完成前将停止的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！