每个循环双倍(如何解决此问题?Excel VBA

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 填写表单，连同输入到表单上的这些名称，他们将使用 excel 工作表本身中的 vlookups 填写表单的其余部分，所以我的最终目标是拥有这种表格，其中 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"列获取数据。有了这么多数据，一次复制和粘贴一个单元格需要很长时间 - 从数组中读取和写入要好得多。

下面的代码显示了这两点。我真的不明白你为什么要把每个项目都写成"新！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