为什么这个嵌套循环不起作用?

时间:2015-06-05 12:10:31

标签: excel vba excel-vba

我无法将其循环到下一行。内部的两个循环工作正常,我可以使用调试器告诉它,但它永远不会进入下一行。任何帮助将不胜感激。

Sub PopulateData()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim locationRow As Integer
Set s1 = ThisWorkbook.Sheets("Order_LVL")
Set s2 = ThisWorkbook.Sheets("sheet1")
Dim Lastrow As Integer
Lastrow = s1.Cells(Rows.Count, 1).End(xlUp).Row
Dim iRow As Integer

For iRow = 1 To Lastrow
Dim cellj As Range
    For Each cellj In s1.Range("B:F")
    locationRow = 1
    Dim celli As Range
        For Each celli In s2.Range("B1:F1")
        Dim currentrow As Long
        currentrow = iRow + 1
            If s1.Cells(currentrow, cellj.Column).Value = 0 Then

            ElseIf s1.Cells(currentrow, cellj.Column).Value <>   s2.Cells(locationRow, celli.Column).Value And s2.Cells(currentrow, celli.Column).Value = 0 Then
            s2.Cells(currentrow, celli.Column).Value = 0
            Else: s2.Cells(currentrow, celli.Column).Value = 1 'indicates that this order features a line from this location
            End If
        Next celli
    Next cellj
Next iRow
End Sub

1 个答案:

答案 0 :(得分:0)

你可以尝试一些测试数据吗(注意我自己没有测试过,只用两个循环重写它)

Sub PopulateData()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim rng As range: Dim rng2 As range
Dim cell: Dim header

With Application
    .ScreenUpdating = False
End With

With ThisWorkbook
    Set s1 = .Sheets("Order_LVL")
    Set s2 = .Sheets("sheet1")
End With

With s1
    Set rng = range(.Cells(1, 2), .Cells(.Cells(Rows.Count, 6).End(xlUp).Row, 6)) ' Used Range in Order_LVL
End With

Set rng2 = range(s2.Cells(1, 2), s2.Cells(1, 6)) 'Header range in sheet1

For Each cell In rng.Cells
    For Each header In rng2.Cells
        If cell.value = 0 Then

        ElseIf cell.value <> header.value And s2.Cells(cell.Row, header.Column).value = 0 Then
            s2.Cells(cell.Row, header.Column).value = 0 ' Not sure why you're doing this - if it is already 0 why set it back to 0. Left it in for continuity
        Else
            s2.Cells(cell.Row, header.Column).value = 1 ' indicates that this order features a line from this location
        End If
    Next header
Next cell

With Application
    .ScreenUpdating = True
End With
End Sub

如果我理解正确,它应该做你想要的。