如果循环有4个结果

时间：2017-10-20 07:49:19

标签： excel vba excel-vba loops if-statement

我需要执行if循环。现在我知道（部分）理论和我想要的变量。我只需要一个litlle帮助，你知道，实际的循环。我已经概述了下面的情况：

每个独特的人可以有多个偏好（最多3个）。列BO（第2行和第2行）中显示了不同的首选项。列BV, BZ & CD包含Preference1,2和3. Dataset

我希望发生的事情是：BO列中的数据会被放入dim ToBeFunction。然后检查这是否等于列BV中的首选项。如果是，请将{1（对于pref1）写入A1上的单元格WB2。如果没有，ToBeFunction == BZ - ＆gt;写2到WB2, cellA1。如果没有，ToBeFunction==CD - ＆gt;写3到WB2, cellA1。否则在WB2, cellA1

中加0

如果它更容易，0-3可以被相应列的标题标题替换。

我希望我的问题清楚明了。如果没有，请让我澄清。

提前致谢。

Edit2：Tigregalis方法

Sub Test12()
' NOTE: I've designed this to allow me to deal with sparse rows; i.e. when cell "BO#" is empty, don't do anything and don't increment the output row
Const StBestand = "Stambestand.xlsm"
Const Competenties = "Competenties.xlsx"

Dim WbStambestand, WbIjk As Workbook
Dim stam, comp As String
Dim PathOnly, ijk, FileOnly As String
Dim WsIjk, WsStam As Worksheet

ijk = ThisWorkbook.FullName
FileOnly = ThisWorkbook.Name
PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
stam = PathOnly & "\" & StBestand
comp = PathOnly & "\" & Competenties

Set WsIjk = ActiveSheet
Set WbIjk = ThisWorkbook
Set WbStambestand = Workbooks.Open(stam)
Set WsStam = WbStambestand.Worksheets("stambestand")

    Dim rngInput As Range, rngOutput As Range
    Dim lastRowInput As Long


With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
    Set rngInput = .Cells(2, "BO") ' set start of input range; I'm using column 1 so that we can refer to other columns by letter instead of number easily, because we will be working with a sparse set of columns: BO, BV, BZ, CD
    lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
End With
Set rngOutput = WsIjk.Range("A3") ' set start of output range; I'm using ActiveWorkbook.Worksheets(2).Range("A2") just as an example, modify it to your output workbook, output sheet, and start of output range

Debug.Print rngInput.Value
Do Until rngInput.Row > lastRowInput ' loop termination condition

    If rngInput(, "BO").Value <> "" Then ' output condition; you could of course use any more relevant condition, or remove this check entirely (if not having to deal with sparse rows)

        Select Case rngInput(, "BO").Value ' get the value of cell "BO#"
            Case rngInput(, "BV").Value
                rngOutput.Value = 1
            Case rngInput(, "BZ").Value
                rngOutput.Value = 2
            Case rngInput(, "CD").Value
                rngOutput.Value = 3
            Case Else
                rngOutput.Value = 0
        End Select

        Set rngOutput = rngOutput(2) ' increment the output row

    End If
    Set rngInput = rngInput(2) ' always increment the input row
Loop

End Sub

Edit2：Vitayata方法：

Public Sub TestMe()

Const StBestand = "Stambestand.xlsm"
Const Competenties = "Competenties.xlsx"

Dim WbStambestand, WbIjk As Workbook
Dim stam, comp As String
Dim PathOnly, ijk, FileOnly As String
Dim WsIjk, WsStam As Worksheet
Dim LastRow As Long
Dim rngOutput As Range

ijk = ThisWorkbook.FullName
FileOnly = ThisWorkbook.Name
PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
stam = PathOnly & "\" & StBestand
comp = PathOnly & "\" & Competenties

Set WsIjk = ActiveSheet
Set WbIjk = ThisWorkbook
Set WbStambestand = Workbooks.Open(stam)
Set WsStam = WbStambestand.Worksheets("stambestand")
LastRow = WsStam.Range("S2").End(xlDown).Row

Dim cnt As Long

Set rngOutput = WsIjk.Range("A3")
'Set rngInput = WsStam.Range("BO2")


For cnt = 2 To LastRow
    Debug.Print Range("BO" & cnt)
    'Stop 'uncomment it later
    Select Case Range("BO" & cnt).Value
        Case ("BV" & cnt)
            rngOutput = 1
        Case ("BZ" & cnt)
            rngOutput = 2
        Case ("CD" & cnt)
            rngOutput = 3
        Case Else
            rngOutput = 0
    End Select

 Set rngOutput = rngOutput(2) ' increment the output row
 'Set rngInput = rngInput(2)

Next cnt

End Sub

2 个答案:

答案 0 :(得分：1)

如果我正确地理解它，你需要循环“BO”中的单元格并相应地执行一些操作。因此，您需要一个循环来检查值并执行操作。

Option Explicit

Public Sub TestMe()

    Dim cnt As Long

    For cnt = 2 To 5
        debug.print Range("BO" & cnt)
        stop 'uncomment it later
        Select Case Range("BO" & cnt)
            Case ("BV" & cnt)
                Range("A1") = 1
            Case ("BZ" & cnt)
                Range("A1") = 3
            Case Else
                MsgBox "Else"
        End Select
    Next cnt

End Sub

尝试上面的代码并查看案例。它们可以轻松编辑。一旦停在代码的停止部分，尝试查看您在即时窗口中获得的内容。立即打开快捷方式窗口 - Ctrl + G 。

答案 1 :(得分：0)

编辑：删除了原来的答案，根据我的原始答案解决了提问者的实施问题

问题

请参阅以下块中的第二行。

你有：

    With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        Set rngInput = .Cells(2, "BO") ' set start of input range; I'm using column 1 so that we can refer to other columns by letter instead of number easily, because we will be working with a sparse set of columns: BO, BV, BZ, CD
        lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
    End With

我有：

    With ActiveWorkbook.Worksheets(1) ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        Set rngInput = .Cells(2, 1) ' set start of input range; I'm using column 1 so that we can refer to other columns by letter instead of number easily, because we will be working with a sparse set of columns: BO, BV, BZ, CD
        lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
    End With

您的输入范围正在初始化为单元格＆＃34; BO2＆＃34;。我的输入范围是初始化到单元格＆＃34; A2＆＃34; （这是设计）。我会解释一下。

当您致电rngInput(, "BO")时，其功能是将相对的单元格设为rngInput。

  • 第一个参数是相对行，在此示例中为空，因此这意味着＆＃34;与rngInput相同的行＆＃34;。
  • 第二个参数是相对列。在这个例子中它是＆＃34; BO＆＃34 ;;这是什么意思＆＃34;列BO＆＃34;？不一定是相对列。我将以一个例子来解释。

使用立即窗口：

?Range("A2")(,"BO").Address
$BO$2

?Range("BO2")(,"BO").Address
$EC$2

为什么呢？返回的范围是 relative 到输入范围，参数是行的 relative 增量（如果＆gt; = 1）或减量（如果＆lt; = 0）和列。当在Range函数中使用时，Excel将某些键存储为数字的别名："BO"实际上是数字67（第67列）的别名，"BV"是74， "BZ"为78，"CD"为82。

解决方案

您有多种选择，这取决于您的编码风格，要求和其他因素。

1将开始rngInput设置为Sheet.Cells(2, 1)或Sheet.Range("A2")

这是我的榜样。

Sub TestOptionOne()
' Option one: input data is relative to column 1
' NOTE: I've designed this to allow me to deal with sparse rows; i.e. when cell "BO#" is empty, don't do anything and don't increment the output row
    Const StBestand = "Stambestand.xlsm"
    Const Competenties = "Competenties.xlsx"

    Dim WbStambestand As Workbook, WbIjk As Workbook
    Dim stam As String, comp As String
    Dim PathOnly As String, ijk As String, FileOnly As String
    Dim WsIjk As Worksheet, WsStam As Worksheet

    ijk = ThisWorkbook.FullName
    FileOnly = ThisWorkbook.Name
    PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
    stam = PathOnly & "\" & StBestand
    comp = PathOnly & "\" & Competenties

    Set WsIjk = ActiveSheet
    Set WbIjk = ThisWorkbook
    Set WbStambestand = Workbooks.Open(stam)
    Set WsStam = WbStambestand.Worksheets("stambestand")

    Dim rngInput As Range, rngOutput As Range
    Dim lastRowInput As Long

    With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        Set rngInput = .Cells(2, 1) ' set start of input range to A2; I'm using column 1 so that we can refer to other columns by letter instead of number easily, because we will be working with a sparse set of columns: BO, BV, BZ, CD
        lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range in column BO; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
    End With
    Set rngOutput = WsIjk.Range("A3") ' set start of output range; I'm using ActiveWorkbook.Worksheets(2).Range("A2") just as an example, modify it to your output workbook, output sheet, and start of output range

    Debug.Print rngInput.Value
    Do Until rngInput.Row > lastRowInput ' loop termination condition

        If rngInput(, "BO").Value <> "" Then ' output condition; you could of course use any more relevant condition, or remove this check entirely (if not having to deal with sparse rows)

            Select Case rngInput(, "BO").Value ' get the value of cell "BO#"
                Case rngInput(, "BV").Value ' compare against the value of cell "BV#"
                    rngOutput.Value = 1
                Case rngInput(, "BZ").Value ' compare against the value of cell "BZ#"
                    rngOutput.Value = 2
                Case rngInput(, "CD").Value ' compare against the value of cell "CD#"
                    rngOutput.Value = 3
                Case Else
                    rngOutput.Value = 0
            End Select

            Set rngOutput = rngOutput(2) ' increment the output row

        End If
        Set rngInput = rngInput(2) ' always increment the input row
    Loop

End Sub

2将开始rngInput设置为Sheet.Cells(2, "BO")或Sheet.Range("BO2")

您将需要确定相对＆＃34;置换＆＃34;每个输入范围，例如，查看相对于BZ（67）的列BV（74），它是第8列（74-67 + 1）。

Sub TestOptionTwo()
' Option two: input data is relative to column BO
' NOTE: I've designed this to allow me to deal with sparse rows; i.e. when cell "BO#" is empty, don't do anything and don't increment the output row
    Const StBestand = "Stambestand.xlsm"
    Const Competenties = "Competenties.xlsx"

    Dim WbStambestand As Workbook, WbIjk As Workbook
    Dim stam As String, comp As String
    Dim PathOnly As String, ijk As String, FileOnly As String
    Dim WsIjk As Worksheet, WsStam As Worksheet

    ijk = ThisWorkbook.FullName
    FileOnly = ThisWorkbook.Name
    PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
    stam = PathOnly & "\" & StBestand
    comp = PathOnly & "\" & Competenties

    Set WsIjk = ActiveSheet
    Set WbIjk = ThisWorkbook
    Set WbStambestand = Workbooks.Open(stam)
    Set WsStam = WbStambestand.Worksheets("stambestand")

    Dim rngInput As Range, rngOutput As Range
    Dim lastRowInput As Long

    With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        Set rngInput = .Range("B2") ' set start of input range to BO2; we will need to refer to the relative columns
        lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range in column BO; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
    End With
    Set rngOutput = WsIjk.Range("A3") ' set start of output range; I'm using ActiveWorkbook.Worksheets(2).Range("A2") just as an example, modify it to your output workbook, output sheet, and start of output range

    Debug.Print rngInput.Value
    Do Until rngInput.Row > lastRowInput ' loop termination condition

        'BO = 67 (absolute column no.); BO vs BO = 67 - 67 + 1 = 1 (column no. relative to BO)
        'BV = 74 (absolute column no.); BV vs BO = 74 - 67 + 1 = 8 (column no. relative to BO)
        'BZ = 78 (absolute column no.); BZ vs BO = 74 - 67 + 1 = 12 (column no. relative to BO)
        'CD = 82 (absolute column no.); CD vs BO = 82 - 67 + 1 = 16 (column no. relative to BO)

        If rngInput(, 1).Value <> "" Then ' output condition; you could of course use any more relevant condition, or remove this check entirely (if not having to deal with sparse rows)

            Select Case rngInput(, 1).Value ' get the value of cell "BO#"
                Case rngInput(, 8).Value ' compare against the value of cell "BV#"
                    rngOutput.Value = 1
                Case rngInput(, 12).Value ' compare against the value of cell "BZ#"
                    rngOutput.Value = 2
                Case rngInput(, 16).Value ' compare against the value of cell "CD#"
                    rngOutput.Value = 3
                Case Else
                    rngOutput.Value = 0
            End Select

            Set rngOutput = rngOutput(2) ' increment the output row

        End If
        Set rngInput = rngInput(2) ' always increment the input row
    Loop

End Sub

如果您更喜欢使用数字，请选择此方法。它是最简洁的，也是我通常采用的方法。

3每列有多个rngInput*

这可能是最容易理解的。您需要单独加载每个rngInput*变量并同步递增每个rngInput*变量。

Sub TestOptionThree()
' Option three: each input is manipulated independently
' NOTE: I've designed this to allow me to deal with sparse rows; i.e. when cell "BO#" is empty, don't do anything and don't increment the output row
    Const StBestand = "Stambestand.xlsm"
    Const Competenties = "Competenties.xlsx"

    Dim WbStambestand As Workbook, WbIjk As Workbook
    Dim stam As String, comp As String
    Dim PathOnly As String, ijk As String, FileOnly As String
    Dim WsIjk As Worksheet, WsStam As Worksheet

    ijk = ThisWorkbook.FullName
    FileOnly = ThisWorkbook.Name
    PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
    stam = PathOnly & "\" & StBestand
    comp = PathOnly & "\" & Competenties

    Set WsIjk = ActiveSheet
    Set WbIjk = ThisWorkbook
    Set WbStambestand = Workbooks.Open(stam)
    Set WsStam = WbStambestand.Worksheets("stambestand")

    Dim rngInput As Range, rngOutput As Range
    Dim lastRowInput As Long

    Dim rngInputPrefSelected As Range, rngInputPref1 As Range, rngInputPref2 As Range, rngInputPref3 As Range, rngOutput As Range

    With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        Set rngInputPrefSelected = .Range("BO2") ' set start of input range for selected preference to BO2
        Set rngInputPref1 = .Range("BV2") ' set start of input range for preference 1 to BV2
        Set rngInputPref2 = .Range("BZ2") ' set start of input range for preference 2 to BZ2
        Set rngInputPref3 = .Range("CD2") ' set start of input range for preference 3 to CD2
        lastRowInput = .Cells(.Rows.Count, "BO").End(xlUp).Row ' get last row of input range in column BO; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)
    End With
    Set rngOutput = WsIjk.Range("A3") ' set start of output range; I'm using ActiveWorkbook.Worksheets(2).Range("A2") just as an example, modify it to your output workbook, output sheet, and start of output range

    Debug.Print rngInputPrefSelected.Value, rngInputPref1.Value, rngInputPref2.Value, rngInputPref3.Value
    Do Until rngInput.Row > lastRowInput ' loop termination condition

        If rngInputPrefSelected.Value <> "" Then ' output condition; you could of course use any more relevant condition, or remove this check entirely (if not having to deal with sparse rows)

            Select Case rngInputPrefSelected ' get the value of cell "BO#"
                Case rngInputPref1.Value ' compare against the value of cell "BV#"
                    rngOutput.Value = 1
                Case rngInputPref2.Value ' compare against the value of cell "BZ#"
                    rngOutput.Value = 2
                Case rngInputPref3.Value ' compare against the value of cell "CD#"
                    rngOutput.Value = 3
                Case Else
                    rngOutput.Value = 0
            End Select

            Set rngOutput = rngOutput(2) ' increment the output row

        End If

        'always increment the input row
        Set rngInputPrefSelected = rngInputPrefSelected(2) ' move to next row for selected preference
        Set rngInputPref1 = rngInputPref1(2) ' move to next row for preference 1
        Set rngInputPref2 = rngInputPref3(2) ' move to next row for preference 2
        Set rngInputPref3 = rngInputPref2(2) ' move to next row for preference 3
    Loop

End Sub

这种方法的优点是硬编码很少。缺点是它也更冗长。

每次

获取行和列的范围引用

将行号存储为Long变量。循环时，递增行号（row = row + 1）。比较值时，每次都要调用Worksheet.Cells(row, col)来构建一个新的Range对象; col将是您的输入列引用（在这种情况下，这是绝对行/列号或引用），您可以将其存储为常量。

e.g。 If WsStam.Cells(row, 67) = WsStam.Cells(row, 74) Then或If WsStam.Cells(row, "BO") = WsStam.Cells(row, "BV") Then或If WsStam.Cells(row, colSelected) = WsStam.Cells(row, colPref1) Then 

Sub TestOptionFour()
' Rows and columns
' NOTE: I've designed this to allow me to deal with sparse rows; i.e. when cell "BO#" is empty, don't do anything and don't increment the output row
    Const StBestand = "Stambestand.xlsm"
    Const Competenties = "Competenties.xlsx"

    Dim WbStambestand As Workbook, WbIjk As Workbook
    Dim stam As String, comp As String
    Dim PathOnly As String, ijk As String, FileOnly As String
    Dim WsIjk As Worksheet, WsStam As Worksheet

    ijk = ThisWorkbook.FullName
    FileOnly = ThisWorkbook.Name
    PathOnly = Left(ijk, Len(ijk) - Len(FileOnly))
    stam = PathOnly & "\" & StBestand
    comp = PathOnly & "\" & Competenties

    Set WsIjk = ActiveSheet
    Set WbIjk = ThisWorkbook
    Set WbStambestand = Workbooks.Open(stam)
    Set WsStam = WbStambestand.Worksheets("stambestand")

    Dim rngOutput As Range
    Dim lastRowInput As Long

    Dim row As Long
    row = 2 'start row = 2
    Const colSelected As Long = 67, colPref1 As Long = 74, colPref2 As Long = 78, colPref3 As Long = 82
    'selected = BO = 67 (absolute column no.)
    'pref1 = BV = 74 (absolute column no.)
    'pref2 = BZ = 78 (absolute column no.)
    'pref3 = CD = 82 (absolute column no.)

    Set rngOutput = WsIjk.Range("A3") ' set start of output range; I'm using ActiveWorkbook.Worksheets(2).Range("A2") just as an example, modify it to your output workbook, output sheet, and start of output range
    With WsStam ' input data sheet; I'm using ActiveWorkbook.Worksheets(1) just as an example, modify it to your input workbook and input sheet
        lastRowInput = .Cells(.Rows.Count, colSelected).End(xlUp).row ' get last row of input range in column BO; I'm using the Worksheet.Cells(Worksheet.Rows.Count, "BO").End(xlUp).Row method; this is used in my loop termination condition (i.e. terminate when current row > lastRowInput)

        Debug.Print .Cells(row, colSelected).Value
        Do Until row > lastRowInput ' loop termination condition

            If .Cells(row, colSelected).Value <> "" Then ' output condition; you could of course use any more relevant condition, or remove this check entirely (if not having to deal with sparse rows)

                Select Case .Cells(row, colSelected).Value ' get the value of cell "BO#"
                    Case .Cells(row, colPref1).Value ' compare against the value of cell "BV#"
                        rngOutput.Value = 1
                    Case .Cells(row, colPref2).Value ' compare against the value of cell "BZ#"
                        rngOutput.Value = 2
                    Case .Cells(row, colPref3).Value ' compare against the value of cell "CD#"
                        rngOutput.Value = 3
                    Case Else
                        rngOutput.Value = 0
                End Select

                Set rngOutput = rngOutput(2) ' increment the output row

            End If
            row = row + 1 ' always increment the input row
        Loop

    End With

End Sub

这是一种简单的方法。

其他解决方案

将列号存储为常量

选项二，但不是在整个代码中使用实际的相对列数，而是可以存储这些常量。如果结构可能会改变，我会使用这种方法，我想防止不得不重写代码。

所有rngInput变量作为单个集合或类似的

与选项3类似，但您可以初始化rngInput s的某种可迭代对象（例如Collection，Array，Dictionary），然后在以下情况下循环它们：A）检查匹配*和B）。

*如果使用此方法，您还可以使用Function代替Select Case或If Then ElseIf来检查匹配项。

如果我有许多或不确定的输入变量数量，并且希望阻止重写代码，那么我将使用这种方法。

相关问题
最新问题