很大程度上压缩（不实际）循环的VBA代码; 嵌套For …下一个循环
大家好，让我们先简单介绍一下我的项目，然后再跟进我的具体问题和代码。
目前我正在构build一个程序来自动化填充模板的过程。 这个模板经常超过6万行数据，而且我通过插入新的数据表并运行它来构build它的绝大部分工作来逐月运行。 目前所有的工作都是基于一个数据表，我手动导入到excel中。 这个数据表不包含我需要填充模板的所有数据，现在我开始引入额外的数据来补充这个。 这里的问题在于数据关联。 当我最初从一张数据表中拉出来的时候，我不用担心，如果我为每一行提取的数据与其他行一致，因为它们全部来自同一张表。 现在我必须跨两张纸交叉检查数据，以确认它是拉动正确的信息。
现在为你所需要知道的。 我正在填写一个名为Haircut的专栏，但在此之前，我需要确认我正在将正确的剪发号码与相关的正确的剪发号码相关联，该Trade ID已经填充到上一行的模板中码。
使用我在整个项目中使用的类似逻辑，这是我必须执行此任务的代码片段。
Dim anvil as Worksheet Dim ALLCs as worksheet Dim DS as worksheet '''''''''''''''''''''''''''''code above this line is irrelevant to answer this question ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then Anvil.Select For y = 1 To 80 If Anvil.Cells(1, y) = "Haircut" Then For Z = 1 To 80 If Anvil.Cells(1, Z) = "Trade ID" Then For t = 2 To 70000 For u = 16 To 70000 If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then ALLCs.Cells(u, 27) = Anvil.Cells(t, y) End If Next Next End If Next End If Next 这个代码加上我假设的其他代码在理论上是可行的，但是我只能想象它将花费大量的时间（这个程序已经花费了7分半钟的时间）。 任何关于如何用更好的function重写这些代码的build议，遵循这个一般逻辑？
任何帮助表示赞赏，无论您是否完全修改代码，或者如果您提供关于如何减less循环的build议。 除了屏幕更新和计算build议之外，我还在寻找一些可以加快代码的build议。
如果我理解正确的逻辑，那么你可以用一个.Find()方法replace除了一个循环之外的所有循环，如下所示：
'// Dimension range objects for use Dim hdHaricut As Excel.Range Dim hdTradeID As Excel.Range Dim foundRng As Excel.Range With Anvil With .Range("A1:A80") '// Range containing headers '// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell. Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole) Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole) End With '// Only if BOTH of the above range objects were found, will the following block be executed. If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then For t = 2 To 70000 '// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists '// in the other sheet by using another .Find() method. Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole) '// If it exists, then pass that value to another cell on the same row If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value '// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration. Set foundRng = Nothing Next End If End With