选择在VBA中失败的案例？
选择在VBA中失败的案例？
提问于 2018-01-17 16:11:01
我使用select case语句和一个函数一起在VBA中创建fall，但我似乎不知道应该如何构造它。下面是我要做的事情：
- 检查行值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的每一行来确定这一点。一行不影响另一行；1-10中的任何/所有/没有行都可以有空白单元格，尽管它们都具有相同的唯一ID。
- 检查第一行和最后一行之间的所有行中的空单元格
- 用空白单元格连接所有行的唯一ID。
问题是:我需要10+9+8+7+6+5+4+3+2嵌套select语句来进行第一次检查。
下面是一个psuedocode示例：
开始第一个循环(第一个范围: 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回答 1
Stack Overflow用户
发布于 2018-03-20 18:10:24
我重写了您的selectcasefallthrough，使其更加灵活，并添加了一些额外的评论。因为我不确定您的psuedocode的哪个部分正在给您带来麻烦，所以我没有添加任何额外的功能。但是，我可以编辑它们，一旦我知道您当前要执行的是哪个psuedocode步骤。
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/48305438
复制相关文章
相似问题
腾讯云开发者
