VBA - 过度使用IF语句

时间:2017-12-20 10:43:48

标签: excel vba excel-vba

请记住,我是VBA首席开发人员。

我有大量的IF语句,我100%确定这可以而且必须更短,但我不知道如何这样做。

如果你的确回答了我的问题,你能用它来解释答案吗?

这是我的代码:

'Live date tracker'!R4 = Start from date
'Live date tracker'!R5 = End date
'Project Log'!E:E equals Project names column
'Project Log'!L:L equals Project Live date column

7 个答案:

答案 0 :(得分:1)

您可能想要查看select case。这需要输入(单元格DK3 nogwat)并将其与不同的情况进行比较。

Sub selectcase()

Dim var As Range
Dim wSheet As Worksheet 'make some for the other worksheets as well

Set wSheet = ActiveSheet
Set var = wSheet.Range("DK3")

    Select Case var.Value 'insert variable (or range) to test DK3 in this case
    Case wSheet.Range("input range") 'check to see if it matches the value in sheet 3, cell ...
         call ...  'output, modify this to your use
    Case wSheet.Range("I18")
         MsgBox "It's I18"
    Case wSheet.Range("I19")
         MsgBox "It's I19"
    Case Else
         MsgBox "It's none"
End Select

End Sub

由于代码的复杂性,我不太了解你的行为,所以我不知道你是否可以按照自己的意愿使用它。

答案 1 :(得分:0)

此更改可为您节省14行。

Dim innerMostCodeExecuted As Boolean    ' Default value of a bool is false.

If Sheets("Tab 1 - Prijslijst").Range("DK" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("W" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DL" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("X" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DM" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("Y" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DN" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("Z" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DO" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AA" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DP" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AB" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DQ" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AC" & xlCell2.Row).Value Then
    If Sheets("Tab 1 - Prijslijst").Range("DR" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AD" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DS" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AE" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DT" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AF" & xlCell2.Row).Value Then
        If Sheets("Tab 1 - Prijslijst").Range("DU" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AG" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DV" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AH" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DW" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AI" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DX" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AJ" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DY" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AK" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DZ" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AL" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("EA" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AM" & xlCell2.Row).Value Then
            If Sheets("Tab 1 - Prijslijst").Range("EB" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AN" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("EC" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AO" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("ED" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("AP" & xlCell2.Row).Value Then
                If Sheets("Tab 1 - Prijslijst").Range("CQ" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("C" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CR" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("D" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CS" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("E" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CT" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("F" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CU" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("G" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CV" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("H" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CW" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("I" & xlCell2.Row).Value Then
                    If Sheets("Tab 1 - Prijslijst").Range("CX" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("J" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CY" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("K" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("CZ" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("L" & xlCell2.Row).Value Then
                        If Sheets("Tab 1 - Prijslijst").Range("DA" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("M" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DB" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("N" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DC" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("O" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DD" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("P" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DE" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("Q" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DF" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("R" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DG" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("S" & xlCell2.Row).Value Then
                            If Sheets("Tab 1 - Prijslijst").Range("DH" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("T" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DI" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("U" & xlCell2.Row).Value And Sheets("Tab 1 - Prijslijst").Range("DJ" & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range("V" & xlCell2.Row).Value Then

                                ' Set to true, so we know this block was executed.
                                innerMostCodeExecuted = True

                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End If


' Remove repeated else blocks.
If innerMostCodeExecuted = False Then ntofourty xlCell3, xlCell2

答案 2 :(得分:0)

试试此代码,根据需要进行修改:

Dim xranges As Variant, yranges As Variant, countranges As Long
xranges = Array("DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY")
yranges = Array("W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL")
countranges = 0
For i = 0 To UBound(xranges)
    If Sheets("Tab 1 - Prijslijst").Range(xranges(i) & xlCell3.Row).Value = Sheets("Tab 2 - Nieuwe prijzen").Range(yranges(i) & xlCell2.Row).Value Then
        countranges = countranges + 1
    End If
next i

If countranges = UBound(xranges) + 1 Then
    Call ntofourty(xlCell3, xlCell2)
End If

答案 3 :(得分:0)

我认为你需要这样的事情:
col1是"标签1 - Prijslijst"中的范围 col2是"标签2中的范围的开始 - Nieuwe prijzen"
如果您想更改范围,请修改Range("C:C").Column部分

Dim ws1 As Worksheet: Set ws1 = Worksheet("Tab 1 - Prijslijst")
Dim ws2 As Worksheet: Set ws2 = Worksheet("Tab 2 - Nieuwe prijzen")

Dim row1 As Integer: row1 = xlCell3.row
Dim col1 As Integer
Dim row2 As Integer: row2 = xlCell2.row
Dim col2 As Integer: col2 = Range("C:C").Column

innerMostCodeExecuted = True

For col1 = Range("CQ:CQ").Column To Range("EA:EA").Column
    If ws1.Cells(xlCell3.row, col1).Value <> ws2.Cells(xlCell2.row, col2).Value Then
        innerMostCodeExecuted = False
        Exit For
    End If
    col2 = col2 + 1
Next

答案 4 :(得分:0)

好的,所以我的回答是建立在@ SBF的答案之上。我们有非常相似的想法,但他们的答案不会遍历你想要检查的每个范围,所以我将循环放在一个函数中,以便在每次迭代时都调用它。希望它有所帮助。

Sub test()

    Dim ws1 As Worksheet: Set ws1 = Worksheets("Tab 1 - Prijslijst")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Tab 2 - Nieuwe prijzen")

    Dim xlcell2 As Range: Set xlcell2 = ws1.Range("A1")
    Dim xlcell3 As Range: Set xlcell3 = ws2.Range("A1")

    Dim row1 As Long: row1 = xlcell3.Row
    Dim row2 As Long: row2 = xlcell2.Row

    'each range you want to check
    Dim range1a As Range: Set range1a = ws1.Range("DK" & row1 & ":" & "DQ" & row1)
    Dim range1b As Range: Set range1b = ws2.Range("W" & row2 & ":" & "AC" & row2)

    Dim range2a As Range: Set range2a = ws1.Range("DR" & row1 & ":" & "DT" & row1)
    Dim range2b As Range: Set range2b = ws2.Range("AD" & row2 & ":" & "AF" & row2)

    '...and so on


    Dim innerMostCodeExecuted As Boolean

    If CheckRangeEqual(range1a, range1b, row1, row2) = True Then
        If CheckRangeEqual(range2a, range2b, row1, row2) = True Then
            '...and so on

            innerMostCodeExecuted = True
        End If
    End If

    If innerMostCodeExecuted = False Then ntofourty xlcell3, xlcell2

End Sub


Function CheckRangeEqual(range1 As Range, range2 As Range, row1 As Long, row2 As Long) As Boolean

    Dim areEqual As Boolean: areEqual = True

    Dim currentCol As Long

    For currentCol = 1 To range1.Columns.count - 1
        If range1.Cells(row1, currentCol).Value <> range2.Cells(row2, currentCol).Value Then
            areEqual = False
            Exit For
        End If
    Next

    CheckRangeEqual = areEqual

End Function

由于我必须制作一些用于测试的模拟数据,所以我在这里给了xlcell2和xlcell3一个值,但为了使其适应你的所有你需要做的就是包括其他范围并将它们嵌套在ifs中。由于在检查的内容之间没有可辨别的模式(我可以看到),因此仍然必须手动放入。

答案 5 :(得分:0)

您可以将每一行推到一个单独的函数并检查那里的值 此代码将检查MealDao.createTable(daoSession.getDatabase(), false);范围内的值与'Tab 1 - Prijslijst'!CQ2:ED2中的值。

如果行中的任何单元格不同,则它会在即时窗口中放置 Color Cell。,否则它将放置调用函数。

'Tab 2 - Nieuwe prijzen'!D9:AQ17

答案 6 :(得分:0)

我喜欢把支票放在一个单独的功能中。说这样的话:

Public Function MatchColumns(ByRef tab1_cols() As Variant, ByRef tab2_cols() As Variant, ByVal row_3 As Long, row_2 As Long) As Boolean
    Dim tab1 As Worksheet, tab2 As Worksheet
    Set tab1 = Sheets("Tab 1 - Prijslijst")
    Set tab2 = Sheets("Tab 2 - Nieuwe prijzen")

    Dim n As Long, i As Long
    ' Count elements in array
    n = UBound(tab1_cols) - LBound(tab1_cols) + 1   
    For i = 1 To n
        If tab1.Range(tab1_cols(i - 1) & ":" & tab1_cols(i - 1)).Cells(row_3, 1).Value <> tab2.Range(tab2_cols(i - 1) & ":" & tab2_cols(i - 1)).Cells(row_2, 1).Value Then
            MatchColumns = False
        End If
    Next i
    MatchColumns = True
End Function

然后你的调用代码几乎变得微不足道

Dim tab1_cols() As Variant, tab2_cols() As Variant
tab1_cols = Array("DK", "DL", "DM", "DN", "DO", "DP", "DQ", ...)
tab2_cols = Array("W", "X", "Y", "Z", "AA", "AB", "AC", ...)

If MatchColumns(tab1_cols, tab2_cols, xlCell3.Row, xlCell2.Row) Then
    '----------
    ' Code that is irrelevant to the question
    '----------
Else
    Call ntofourty(xlCell3, xlCell2)
End If