VBA(Excel)无法遍历范围

时间:2017-12-14 10:06:38

标签: excel vba excel-vba

我目前面临的问题是我的代码没有遍历定义的范围,它仍然停留在第一行。

这是我的代码:

Private Sub Vergelijk_prijs_en_staffel_click()

Dim xlRange As Range
Dim xlRange2 As Range
Dim xlCell As Range
Dim xlCell2 As Range
Dim xlSheet As Worksheet
Dim xlSheet2 As Worksheet
Dim ValueToFind
Dim lastRow As Integer

Set xlSheet2 = Sheets(1)
Set xlRange2 = xlSheet2.Range("I6:I5715")

For Each xlCell2 In xlRange2

If ActiveCell.Row > 5715 Then Exit Sub

ValueToFind = xlCell2.Value

    If xlCell2.Value = ValueToFind Then

        If Sheets("Tab 1 - Prijslijst").Range("DK" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("W" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DL" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("X" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DM" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("Y" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DN" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("Z" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DO" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AA" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DP" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AB" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DQ" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AC" & ActiveCell.Row).Value Then
            If Sheets("Tab 1 - Prijslijst").Range("DR" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AD" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DS" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AE" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DT" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AF" & ActiveCell.Row).Value Then
                If Sheets("Tab 1 - Prijslijst").Range("DU" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AG" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DV" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AH" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DW" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AI" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DX" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AJ" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DY" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AK" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DZ" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AL" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("EA" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AM" & ActiveCell.Row).Value Then
                    If Sheets("Tab 1 - Prijslijst").Range("EB" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AN" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("EC" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AO" & ActiveCell.Row).Value And Sheets("Tab 1 - Prijslijst").Range("ED" & ActiveCell.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AP" & ActiveCell.Row).Value Then
                        Sheets("Tab 3 - Prijslijst aangepast").Range("I" & ActiveCell.Row).Interior.ColorIndex = 15
                        xlCell2.Interior.ColorIndex = 15
                    Else
                        Call ntofourty(xlCell2)
                    End If
                Else
                    Call ntofourty(xlCell2)
                End If
            Else
                Call ntofourty(xlCell2)
            End If
        Else
            Call ntofourty(xlCell2)
        End If

    Else

    xlCell2.Interior.ColorIndex = 3

    End If

'Set xlSheet = Sheets(1)
'Set xlRange = xlSheet.Range("I6:I5715")

If ValueToFind = "" Then
    xlCell2.Interior.ColorIndex = 45
    Exit Sub
End If

Next xlCell2

End Sub

你看,末尾的行Next xlCell2应该使它进入范围内的下一个单元格并遍历该单元格的范围和颜色。但是现在,代码的作用是一遍又一遍地着色同一个单元格。

我真的很感激任何帮助!

1 个答案:

答案 0 :(得分:0)

当您要为xlCell2(循环的单元格)着色时,您正在着色rColour(始终是第一行)

编辑:

所以看看更多细节我对这一点感到困惑,我认为你也是这样:-)

 For Each xlCell2 In xlRange2  'what this does is SET the variable xlcell2 
'to each cell in the range xlrange2

If ActiveCell.Row > 5715 Then Exit Sub 'this isn't needed because you defined the range 
to stop at row 5715 - it cannot exceed this.

ValueToFind = xlCell2.Value 'ok, so each time through valuetofind = 
'the value in the current cell pointed to by xlcell2

    If xlCell2.Value = ValueToFind Then 'so this is always true because valuetofind 
'changes at every row -so why have it?
And then you have a bunch of if statements that look at the activecell - 
'but we have no idea what that is - the activecell could be any cell - it could even 
'be on a different spreadsheet! Did you mean the row that contains the cell that xlcell2 
'is pointing to?