Excel 2007 VBA复制匹配行循环

我有一个工作簿，有一个“源”工作表和几个目标工作表。从本质上说，源代码表包含我需要匹配并拆分给团队成员的信息。下面的代码冻结了excel，就像它陷入了一个永无止境的循环。VBA存在于源工作表的VBA上

Sub SearchForString()

Dim ws As Worksheet
Dim x As Integer
Dim y As Integer
Dim z as Integer

x = 1
y = 1
z = 4 'in this case we are looking at column D as the last non-criteria column


For Each ws In Worksheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7"))
    x = 1 'setting back to row 1 to grab headers
    y = 1
    ws.UsedRange.ClearContents
    Worksheets(ws.Name).Cells(y, 1) = Cells(x, 1)
    Worksheets(ws.Name).Cells(y, 1).Font.Bold = True
    Worksheets(ws.Name).Cells(y, 2) = Cells(x, 2)
    Worksheets(ws.Name).Cells(y, 2).Font.Bold = True
    Worksheets(ws.Name).Cells(y, 3) = Cells(x, 3)
    Worksheets(ws.Name).Cells(y, 3).Font.Bold = True
    Worksheets(ws.Name).Cells(y, 4) = Cells(x, 4)
    Worksheets(ws.Name).Cells(y, 4).Font.Bold = True

    'begin the copy loop
    x = 2 'setting forward to the first row to start evaluating for copy
    y = 2
    z = z + 1 'increments along the columns we are matching in the array

    Do while Cells(x, 1) <> vbNullString  'make sure we have an active row
      If Cells(x, z) = "Yes" Then  ' looks for row plus column for match

        Do While Worksheets(ws.Name).Cells(y, 2) <> vbNullString
          y = y + 1  'setting the row to start pasting
        Loop

        Worksheets(ws.Name).Cells(y, 1) = Cells(x, 1)
        Worksheets(ws.Name).Cells(y, 2) = Cells(x, 2)
        Worksheets(ws.Name).Cells(y, 3) = Cells(x, 3)
        Worksheets(ws.Name).Cells(y, 4) = Cells(x, 4)   
        x = x + 1  'increment to next row
      End If
    Loop

Next ws

End Sub

子SearchForString（）
将ws设置为工作表
作为整数的Dim x
Dim y作为整数
将z调整为整数
x=1
y=1
z=4'在这种情况下，我们将D列视为最后一个非标准列
对于工作表中的每个ws（数组（“Sheet1”、“Sheet2”、“Sheet3”、“Sheet4”、“Sheet5”、“Sheet6”、“Sheet7”））
x=1'设置回第1行以获取标题
y=1
ws.UsedRange.ClearContents
工作表（ws.Name）.Cells（y，1）=Cells（x，1）
工作表（ws.Name）.Cells（y，1）.Font.Bold=True
工作表（ws.Name）.Cells（y，2）=Cells（x，2）
工作表（ws.Name）.Cells（y，2）.Font.Bold=True
工作表（ws.Name）.Cells（y，3）=Cells（x，3）
工作表（ws.Name）.Cells（y，3）.Font.Bold=True
工作表（ws.Name）.Cells（y，4）=Cells（x，4）
工作表（ws.Name）.Cells（y，4）.Font.Bold=True
'开始复制循环
x=2'设置前移到第一行以开始评估副本
y=2
z=z+1'沿数组中匹配的列递增
执行while单元格（x，1）vbNullString'确保有活动行
如果单元格（x，z）=“是”，则“查找匹配的行加列”
Do While工作表（ws.Name）.Cells（y，2）vbNullString
y=y+1'设置要开始粘贴的行
环
工作表（ws.Name）.Cells（y，1）=Cells（x，1）
工作表（ws.Name）.Cells（y，2）=Cells（x，2）
工作表（ws.Name）.Cells（y，3）=Cells（x，3）
工作表（ws.Name）.Cells（y，4）=Cells（x，4）
x=x+1'到下一行的增量
如果结束
环
下一个ws
端接头

---

我看不出有什么东西会像它看起来那样把它塞进一个无休止的循环。有什么让人吃惊的吗？

如果单元格（x，z）“是”，x永远不会增加，单元格（x，1）vbNullString保持为真

就是这样，在If循环中仍然有x=x+1。