Excel 2007 VBA复制匹配的行循环

Question

I've got a workbook with one "source" worksheet and several destination sheets. essentially the source sheet contains information that I need to match and split out to team members. I've got the following code that freezes excel on me like it's stuck in a never ending loop. the VBA exists on the source worksheet's 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

I can't spot what would be sticking it into an endless loop like it seems to be in. Is anything glaring to anyone?

Answer 1

如果Cells（x，z）<>是，则x永远不会递增，并且Cells（x，1）<> vbNullString保持为真