Question

我有2张纸的数据；带有案例ID列表的参考表和带有案例ID，客户名称，编号，描述等的源表。

目标是创建一个VBA循环，以检查参考表的每一行，以及参考< / strong>工作表中，将所有必填字段从源工作表中拉到“目标”工作表中。我当前的VBA代码正在使用偏移量，但这似乎无法正常工作。下面的代码：

Public Sub MainFileData2() Dim i As Long, k As Long Dim wbmacro As Workbook Dim wbmain As Workbook Set wbmacro = Workbooks.Item("MacroFile.xlsm") Set wbmain = Workbooks.Item("SourceFile.csv") Dim wsmacro As Worksheet Dim wsmain As Worksheet Dim wsref As Worksheet Set wsmacro = wbmacro.Worksheets.Item("Data") Set wsmain = wbmain.Worksheets.Item("SourceFileData") Set wsref = wbmacro.Worksheets.Item("Sheet1") Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data") Dim engrange As Range Set engrange = wsmain.Range("B2:B500000") Dim cell As Range k = 1 i = 2 DestLastRow = destsht.Cells(destsht.Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For Each cell In engrange If engrange.Cells(i, 1) = wsref.Cells(k, 1) Then wsmacro.Range("candnum").Offset(i, 0) = wsmain.Range("b2").Offset(i, 0) wsmacro.Range("candname").Offset(i, 0) = wsmain.Range("c2").Offset(i, 0) wsmacro.Range("estat").Offset(i, 0) = wsmain.Range("e2").Offset(i, 0) wsmacro.Range("ira").Offset(i, 0) = wsmain.Range("g2").Offset(i, 0) wsmacro.Range("wrkflw").Offset(i, 0) = wsmain.Range("k2").Offset(i, 0) wsmacro.Range("fln").Offset(i, 0) = wsmain.Range("o2").Offset(i, 0) wsmacro.Range("city").Offset(i, 0) = wsmain.Range("r2").Offset(i, 0) wsmacro.Range("country").Offset(i, 0) = wsmain.Range("s2").Offset(i, 0) i = i + 1 Else: i = i + 1 End If Next cell Application.ScreenUpdating = True End Sub

例如，当代码在i中循环时，它将在源文件的第20行中找到该值，并最终将该值一直粘贴到目标文件（“数据”表）的第20行中，跳过前19个空白行。我尝试使用 destlastrow 而不是 i ，它最终覆盖了该值，并且也无法正常工作。

任何想法/建议将不胜感激。提前致谢。

Answer 1

您的代码的结构实际上应该更像这样-仅将i用作目标行计数器，仅在添加一行后对其进行递增。您的For each cell in engrange将遍历Range("B2:B500000")中的每个单元格-将循环定义为要遍历的范围时，请不要再次在循环中使用engrange。 / p>

尽管，我在这里只能做很多事情，因为我不知道那些命名范围是指什么-IMO，我将完全摆脱命名范围。

Option Explicit
Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")

Dim engrange As Range
Set engrange = wsmain.Range("B2:B500000")

Dim cell As Range

k = 1
i = 2

Application.ScreenUpdating = False

For Each cell In engrange

    If cell.Value = wsref.Cells(k, 1).Value Then

        wsmacro.Cells(i, 1).Value = cell.Offset(, 1).Value
        wsmacro.Cells(i, 2).Value = cell.Offset(, 2).Value
        wsmacro.Cells(i, 3).Value = cell.Offset(, 3).Value
        wsmacro.Cells(i, 4).Value = cell.Offset(, 4).Value
        wsmacro.Cells(i, 5).Value = cell.Offset(, 5).Value
        wsmacro.Cells(i, 6).Value = cell.Offset(, 6).Value
        wsmacro.Cells(i, 7).Value = cell.Offset(, 7).Value
        wsmacro.Cells(i, 8).Value = cell.Offset(, 8).Value

        i = i + 1

    End If

Next cell

Application.ScreenUpdating = True

End Sub

Answer 2

您的代码几乎没有主要问题。并非要苛刻，但希望它能帮助您理解我的建议。

您有两个变量可以用作索引（i，k），但是您只增加了i。 k始终保持不变。这就是为什么只在1行中得到输出的原因。

您还使用了For Each循环，该循环实质上为i上使用的同一数据集添加了另一组不可见索引。最好将For与i一起使用i=i+1循环，这样就不需要enrange并创建IF。

此外，在代码的i语句部分中，您在=号的两边都使用wsmacro，这就是为什么在{{1 }}与wsmain所在的行相同。

在DestLastRow的输出行中使用i而不是wsmacro也会给您带来问题，因为它仅计算一次（循环中没有）为什么数据会被覆盖。

您有3种不同的工作表，因此您需要3种不同的索引。

此外，wsmacro和destsht引用相同的工作表。您不需要两者。

话虽如此，这是我未经测试的建议：

Public Sub MainFileData2()

Dim iDest As Long, iMain As Long, iRef As Long
Dim MainLastRow As Long, RefLastRow As Long

Dim wbMacro As Workbook
Dim wbMain As Workbook

Set wbMacro = Workbooks.Item("MacroFile.xlsm")
Set wbMain = Workbooks.Item("SourceFile.csv")

Dim wsMacro As Worksheet
Dim wsMain As Worksheet
Dim wsRef As Worksheet

Set wsMain = wbMain.Worksheets.Item("SourceFileData")
Set wsRef = wbMacro.Worksheets.Item("Sheet1")
Set wsMacro = wbMacro.Worksheets("Data")

iMacro = 1   'Index for the destination sheet

MainLastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
RefLastRow = wsRef.Cells(wsRef.Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False


For iMain = 2 To MainLastRow    'Go through each row of wsMain
    For iRef = 2 To RefLastRow  'For each row in the Main sheet, go through each row of the reference sheet
        If wsMain.Cells(iMain, 1) = wsRef.Cells(iRef, 1) Then

            wsMacro.Range("candnum").Offset(iMacro, 0) = wsMain.Cells(iMain, "B")
            wsMacro.Range("candname").Offset(iMacro, 0) = wsMain.Cells(iMain, "C")
            wsMacro.Range("estat").Offset(iMacro, 0) = wsMain.Cells(iMain, "E")
            wsMacro.Range("ira").Offset(iMacro, 0) = wsMain.Cells(iMain, "G")
            wsMacro.Range("wrkflw").Offset(iMacro, 0) = wsMain.Cells(iMain, "K")
            wsMacro.Range("fln").Offset(iMacro, 0) = wsMain.Cells(iMain, "O")
            wsMacro.Range("city").Offset(iMacro, 0) = wsMain.Cells(iMain, "R")
            wsMacro.Range("country").Offset(iMacro, 0) = wsMain.Cells(iMain, "S")

            iMacro = iMacro + 1 'Ensures the next output to wsMacro will go in the next row

            Exit For 'The match has been found, so you can move on to the next row in wsMain without checking the rest of the rows in wsRef
        End If
    Next iRef
Next iMain

Application.ScreenUpdating = True

End Sub

Answer 3

一些有用的东西

我建议将engrange更改为Long数据类型并将Set engrange = wsmain.Range("B2:B500000")更改为engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row，这样您就可以利用For Loop了，而不必每次迭代时手动增加i。
我会尝试使用每次迭代都会偏移的输出范围，其中If语句的计算结果为True。现在，它只是采用i值并将其放置在其中，因为您每次迭代都在增加它。
您似乎正在尝试匹配一个值。为什么不使用.Find？而不是遍历整个工作表来寻找匹配的每个值？

我会这样写

Public Sub MainFileData2()

Dim i As Long, k As Long

Dim wbmacro As Workbook
Dim wbmain As Workbook

Set wbmacro = Workbooks.Item("MacroFile.xlsm")
Set wbmain = Workbooks.Item("SourceFile.csv")

Dim wsmacro As Worksheet
Dim wsmain As Worksheet
Dim wsref As Worksheet

Set wsmacro = wbmacro.Worksheets.Item("Data")
Set wsmain = wbmain.Worksheets.Item("SourceFileData")
Set wsref = wbmacro.Worksheets.Item("Sheet1")
Set destsht = Workbooks("MacroFile.xlsm").Worksheets("Data")

Dim engrange As Long
engrange = wsmain.Range("B" & Rows.Count).End(xlUp).Row

Dim fRng as Range

Dim outRng as Range
Set outRng = wsmacro.Range("A2")    

Application.ScreenUpdating = False

For i = 2 to engrange

    Set fRng = wsref.Range("A:A").Find(wsmain.Cells(i, 2),,xlValues,xlWhole)

    If not fRng Is Nothing Then

        outRng.Offset(0, 0) = wsmain.Range("B" & i)
        outRng.Offset(0, 1) = wsmain.Range("C" & i)
        outRng.Offset(0, 2) = wsmain.Range("E" & i)
        outRng.Offset(0, 3) = wsmain.Range("G" & i)
        outRng.Offset(0, 4) = wsmain.Range("K" & i)
        outRng.Offset(0, 5) = wsmain.Range("O" & i)
        outRng.Offset(0, 6) = wsmain.Range("R" & i)
        outRng.Offset(0, 7) = wsmain.Range("S" & i)

        Set outRng = outRng.Offset(1, 0)

    End If

Next i

Application.ScreenUpdating = True


End Sub

查找功能比在每个单元格中查找匹配项要快得多，并且使用Range("B" & Rows.Count).End(xlUp).Row方法将确保您永远不会搜索空白行。

VBA：如果在参考表中找到值，则将数据+字段从源表中拉到目标表中

3 个答案: