双循环（如何解决此问题？）Excel VBA

背景信息：我的工具的目的是我有一个表单，当你在一个单元格中输入一个名字时，它会使用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填写表单，再加上输入到表单中的这些名称，他们将使用excel工作表中的VLOOKUP填写表单的其余部分，因此我的最终目标是使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%      

---

我知道这是长篇大论，只要问我你是否需要任何澄清

您不需要两个循环，只需要在每次迭代中从列“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

Dim home作为变体
变暗
变暗r为长，rMax为长，rOffset为长
Dim output（）作为变量
使用此工作簿。工作表（“获胜率”）
home=.Range（.Range（“H3”）.End（xlDown），.Range（“H”和.Rows.Count）.End（xlUp））.Value2
远离=.Range（.Range（“N3”）.End（xlDown），.Range（“N”和.Rows.Count）.End（xlUp））.Value2
以
rMax=工作表函数.Max（UBound（home，1），UBound（away，1））
ReDim输出（1到rMax，1到2）
对于r=1到rMax
如果只是提到r，请确保在使用
行时完全限定范围。计数
。如果不放置工作表，即
工作表（“满2.5&BTTS列表”）.Rows.Count
，它将从活动工作表中提取行数，而这可能不是您想要的。因此，在您的
With copySheet
循环中，确保在
行之前添加“锚定”
。计数
以确保它在
copySheet
上计数
行。我认为您不需要使用
块2
。请修复缩进。如果您不确定如何操作，请使用的压头（免责声明：我管理该开源项目）。如果看不到您获取的数据，这将非常困难。@Kyle我正在使用的基于excel的工具是在线的，我的网站是thatstat.co.uk，可以在那里下载。如果你也是一个足球迷，可能会有所帮助哈哈