选择案例在 VBA 中失败？

Posted 2023-05-07

【中文标题】选择案例在 VBA 中失败？

【英文标题】：Select Case fall through in VBA?

【发布时间】：2018-01-17 16:11:01

【问题描述】：

我在 VBA 中结合使用 select case 语句和函数来创建失败，但我似乎无法弄清楚它应该如何构建。这是我正在寻找它做的事情：

检查行值 1 和 10 是否具有相同的唯一 ID（如果不是：1&9;1&8,1&7,...,1&2）

1a。如果行值 1 和 10 具有相同的唯一 ID，则其间的所有行也是如此

2a。即使所有行都具有相同的唯一 ID，它并不意味着我以后要检查的单元格都是相同的——例如：第 1、3、4、7、8、10 行可能有空白单元格，而第 2、5、9 行不为空白。为了确定这一点，它必须遍历从 10 到 1 的每一行来确定这一点。一行不影响另一行；尽管它们都具有相同的唯一 ID，但 1-10 中的任何/所有/无行都可以包含空白单元格。

检查第一行和最后一行之间所有行中的空白单元格

将所有行的唯一 ID 与空白单元格连接起来。

问题是这样的：我将需要 10+9+8+7+6+5+4+3+2 嵌套的 select 语句来单独进行第一次检查。

---

这是一个伪代码示例：

开始第一个循环（第一个范围：Excel 工作表第 2-12 行；10 行）：

第 1 行和第 10 行具有相同的唯一 ID

检查第 10 行的空白单元格

第 10 行没有空白单元格

检查第 9 行的空白单元格

找到空白单元格 -> 将信息添加到字符串

检查第 8 行的空白单元格

找到空白单元格 -> 将信息添加到字符串

检查第 7 行的空白单元格

没有找到空白单元格

检查第 6 行的空白单元格

找到空白单元格 -> 将信息添加到字符串

检查第 5 行的空白单元格

....

找不到更多空白单元格

开始第二个循环（第二个范围：Excel 工作表第 12-14 行；3 行）：

单元格 12 和 14 匹配

检查第 14 行是否有空白单元格

找到空白单元格 -> 将信息添加到单独的字符串

检查第 13 行的空白单元格

没有找到空白单元格

检查第 12 行的空白单元格

没有找到空白单元格

---

我当前的代码如下：

Sub selectcasetryagain()
Dim c As Range
Dim r As Range
Dim lastRow As Long
Dim lastCol As Long

lastRow = Range("A:A").End(xlDown).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Set r = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastCol))

For i = 2 To lastRow
    Set c = r.Cells(i, 6)
    Select Case c.Value
        Case SelectCaseFallThru(c)

    End Select
Next i

End Sub

Option Explicit
Public c, r As Range
Public i As Integer
Public lastRow, lastCol As Long
Public RMissing As Variant

Function SelectCaseFallThru(Optional c As Variant, Optional d As Variant)
    If c.Value = c.Offset(10, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(10, 0).Value
        If IsEmpty(c.Offset(0, 46)).Value And IsEmpty(c.Offset(0, 47)).Value Then
            RMissing = c.Offset(0, 42).Value
        i = i + 10
    ElseIf c.Value = c.Offset(9, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(9, 0).Value
        i = i + 9
    ElseIf c.Value = c.Offset(8, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(8, 0).Value
        i = i + 8
    ElseIf c.Value = c.Offset(7, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(7, 0).Value
        i = i + 7
    ElseIf c.Value = c.Offset(6, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(6, 0).Value
        i = i + 6
    ElseIf c.Value = c.Offset(5, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(5, 0).Value
        i = i + 5
    ElseIf c.Value = c.Offset(4, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(4, 0).Value
        i = i + 4
    ElseIf c.Value = c.Offset(3, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(3, 0).Value
        i = i + 3
    ElseIf c.Value = c.Offset(2, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(2, 0).Value
        i = i + 2
    ElseIf c.Value = c.Offset(1, 0).Value Then
        Debug.Print c.Value & " - " & c.Offset(1, 0).Value
        i = i + 1
    Else
        Exit Function
    End If


End Function

【问题讨论】：

我不明白这句话“我需要 10*9*8*7*6*5*4*3*2 嵌套的 select 语句来单独进行第一次检查”。你不只需要 10 个吗？

在我看来你想多了 - 我认为你可以通过两个嵌套循环来实现所有这些

两个值之间的所有行都相同（例如，1&10=相同，然后 2-9=与 1&10 相同）。我希望单独检查每一行并将其唯一 ID 添加到字符串中。如果循环命中一个，那么它不会检查其他条件，据我所知？这意味着它必须在每次命中时更深入一层才能成功收集具有空白单元格的行的所有唯一 ID？

你能发一张截图吗，我正在努力关注这个？

@sjr prnt.sc/i1takf

【参考方案1】：

我重写了您的 selectcasefallthrough 以使其更灵活，并添加了一些额外的 cmets。由于我不确定您的伪代码的哪个部分当前给您带来了麻烦，因此我没有添加任何其他功能。但是，一旦我知道您当前停留在哪个伪代码步骤上，我就可以对其进行编辑。

Sub selectcasetryagain()
Dim c As Range 'Will no longer access Global c
Dim r As Range
Dim lastRow As Long
Dim lastCol As Long

lastRow = Range("A:A").End(xlDown).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Set r = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastCol))

For i = 2 To lastRow
    Set c = r.Cells(i, 6)
    Select Case c.Value
        Case SelectCaseFallThru(10, c) ' Added in row number to make it variable

    End Select
Next i

End Sub

Option Explicit
Public c, r As Range 'Note: currently Global c is defined as a Variant
Public i As Integer
Public lastRow, lastCol As Long
Public RMissing As Variant

'This function does not currently return anything.
Function SelectCaseFallThru(maxRowNum as Integer, Optional c As Variant, Optional d As Variant) 'This Function will use the Optional c, not the Global c
    Dim counter as Integer
    Dim found as Boolean

    For counter = maxRowNum to 1 step -1
        If c.Value = c.Offset(counter, 0).Value Then
            Debug.Print c.Value & " - " & c.Offset(counter, 0).Value
            If IsEmpty(c.Offset(0, 46)).Value And IsEmpty(c.Offset(0, 47)).Value and counter = maxRowNum Then 'added check for counter
                RMissing = c.Offset(0, 42).Value
            End if
            i = i + counter
            found = True
            Exit For
        End If
    Next counter

    If not found Then Exit Function

End Function