Question

背景信息：我的工具的目标是我有一个表单，当您在单元格中输入名称时，它会使用vlookups和基本的Excel代码显示附加到该人员名称的所有详细信息。

现在我正在做的是我想点击一个按钮，让vba通过这个工具运行所有名称，这样表格中的详细信息都存储在一个表格中。下面的代码返回For Each循环中第一个框的第一列数据（如果第二个for循环被删除，这样做很好）。我遇到的问题是我需要一个秒来为每个循环返回第二列值的数据，但问题是每个循环的第一个只运行一次然后它将为每个循环多次运行第二个以返回第二个我需要的数据列。我需要的是每个循环1，可以采取2个范围或完全不同的方式来做到这一点。任何帮助将不胜感激。

Public Sub Button1_Click()

Application.ScreenUpdating = True

Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim r As Range
Dim h As Range

Set copySheet = Worksheets("WIN RATES")

With copySheet
    For Each r In .Range("H3", .Range("H" & Rows.Count).End(xlUp))
        If Len(r) > 0 Then
            Worksheets("NEW! FORM CHARTS").Range("E4").Value = r.Value
            Worksheets("NEW! FORM CHARTS").Range("E4").Resize(, 1).Copy
            Worksheets("Full Over 2.5 & BTTS list").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False

        With copySheet
            For Each h In .Range("N3", .Range("N" & Rows.Count).End(xlUp))
            If Len(h) > 0 Then
            Worksheets("NEW! FORM CHARTS").Range("M4").Value = h.Value
            Worksheets("NEW! FORM CHARTS").Range("M4").Resize(, 1).Copy
            Worksheets("Full Over 2.5 & BTTS list").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
                    End If
                Next h
            End With
        End If
    Next r
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

我希望它返回的方式是这样的：

Name 1 | Name 2 
tom    | 17846
mike   | 16253
steve  | 10987
Anne   | 16243

但是，理解上，我的数据是这样做的：

Name 1 | Name 2 
tom    | 17846
       | 16253
       | 10987
       | 16243

我们的想法是，excel将遍历列表中的所有名称并填写名称1和名称2的表单，并将这些名称输入到表单中，他们将使用vlookups填写表单的其余部分在Excel工作表本身，所以我的最终目标是拥有这样的表，其中vlookup1和vlookup2来自excel表：

Name 1 | Name 2 | VLOOKUPDATA1 | VLOOKUPDATA2
tom    | 17846  |       1      |     80%
mike   | 16253  |       8      |     90%
steve  | 10987  |       6      |     23%
Anne   | 16243  |       3      |     43%

我知道这很长，只要问我是否需要澄清。

Answer 1

您不需要两个循环，只需要在每次迭代中从“H”和“N”列获取数据。有了那么多数据，一次复制和粘贴一个单元格需要花费很长时间 - 你可以更好地从数组中读取和写入。

以下代码显示了这两点。我真的不明白为什么你把每个项目写入“NEW！FORM CHARTS”工作表只是为了用下一个循环写它，所以我把那部分从你的代码中删除了。你会看到有一小部分额外的编码只处理两列不在同一行结束的情况。

我还建议您阅读有关课程的内容，因为这将大大简化并可能加快您的任务。

Dim home As Variant
Dim away As Variant
Dim r As Long, rMax As Long, rOffset As Long
Dim output() As Variant

With ThisWorkbook.Worksheets("WIN RATES")
    home = .Range(.Range("H3").End(xlDown), .Range("H" & .Rows.Count).End(xlUp)).Value2
    away = .Range(.Range("N3").End(xlDown), .Range("N" & .Rows.Count).End(xlUp)).Value2
End With

rMax = WorksheetFunction.Max(UBound(home, 1), UBound(away, 1))

ReDim output(1 To rMax, 1 To 2)
For r = 1 To rMax
    If r <= UBound(home, 1) Then output(r, 1) = home(r, 1)
    If r <= UBound(away, 1) Then output(r, 2) = away(r, 1)
Next

With ThisWorkbook.Worksheets("Full Over 2.5 & BTTS list")
    rOffset = WorksheetFunction.Max(.Range("A1").End(xlUp).Row, .Range("A2").End(xlUp).Row)
    .Range("A1").Offset(rOffset).Resize(UBound(output, 1), UBound(output, 2)).Value = output
End With

Double For Each Loop（如何解决此问题？）Excel VBA

1 个答案: