寻找列

Question

我有一个超过 5 列的 Excel 文件，其中单元格值为 TRUE 和 FALSE。需要在列之间进行比较，如果每列中的所有单元格值为 TRUE，则在第 6 列单元格中输入“无变化”。

| 1    || 2    || 3    || 4    || 5    || 6    |
|:---- ||:---- ||:---- ||:---- ||:---- ||:---- |
| TRUE ||TRUE  ||TRUE  ||TRUE  ||TRUE  ||NO CHange  |

如果这 5 列中的任何单元格的值为 FALSE，则需要知道哪一列（第 2 列或第 3 列或第 5 列）

| 1    || 2    || 3    || 4    || 5    || 6             |
|:---- ||:---- ||:---- ||:---- ||:---- ||:------------- |
|TRUE  ||FALSE ||TRUE  ||TRUE  ||TRUE  ||Change in 2nd  |

或

| 1    || 2    || 3    || 4    || 5    || 6                 |
|:---- ||:---- ||:---- ||:---- ||:---- ||:---------------   | 
|TRUE  ||FALSE ||TRUE  ||FALSE ||TRUE  ||Change in 2 and 4  |

这可能吗？

不确定这是否正确！

Sub Checking()
    Dim i as Integer
    For i=2 to $lastrow
        If (cell(i,1).value = cell(i,2).value = cell(i,3).value = cell(i,4).value = cell(i,5).value = "TRUE") Then 
           cell(i,"6").value = "No Change"
        Else 
            If (cell(i,1).value = "FALSE") Then
             cell(i,6).value = "1 Changed"
            End If
            If (cell(i,2).value = "FALSE") Then
             cell(i,6).value = "2 Changed"
            End If
            If (cell(i,3).value = "FALSE") Then
             cell(i,6).value = "3 changed"
            End If
            If (cell(i,4).value = "FALSE") Then
             cell(i,6).value = "4 Changed"
            End If
            If (cell(i,5).value = "FALSE") Then
             cell(i,6).value = "5 Changed"
            End If
       Next Cell
End Sub

Answer 1

1. 处理数组中的值比逐个访问单元格更快

2. 您应该将用于存储行号的任何变量声明为Long。工作表中的最大行数远高于 Integer 数据类型可以容纳的行数，并且可能导致溢出错误。一般来说，这些天你也没有理由使用Integer 数据类型，所以只需声明为Long。

3. 最好声明所有变量，在模块顶部插入 Option Explicit 以帮助您执行此操作。

由于各种原因，您的代码甚至无法编译，因此您的代码不会修改以下代码：

Option Explicit

Sub Checking()
    Const firstRow As Long = 2
    Const firstColumn As Long = 1
    Const numToCompare As Long = 5
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change name accordingly
    
    '== Find the last row
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, firstColumn).End(xlUp).Row
    
    '== Get the input values into an array to process faster vs accessing the cells 1 by 1
    Dim inputArr As Variant
    inputArr = ws.Range(ws.Cells(firstRow, firstColumn), ws.Cells(lastRow, firstColumn)).Resize(, numToCompare).Value
    
    Dim outputArr() As String
    ReDim outputArr(1 To UBound(inputArr, 1), 1 To 1) As String
    
    Dim i As Long
    Dim falseDict As Object
    
    '== Loop through the array row by row..
    For i = 1 To UBound(inputArr, 1)
        Set falseDict = CreateObject("Scripting.Dictionary")
        
        '== For each row, loop through each column to look for False value, add the column number to the dictionary if found
        Dim n As Long
        For n = 1 To UBound(inputArr, 2)
            If inputArr(i, n) = False Then falseDict(firstColumn + n - 1) = 1
        Next n
        
        'Determine the result string
        Dim output As String
        Select Case falseDict.Count
            Case 0: output = "No Change"
            Case Else
                Dim dictKeys As Variant
                dictKeys = falseDict.Keys
                output = "Change in " & Join(dictKeys, ", ")
        End Select
        
        outputArr(i, 1) = output
    Next i
    Set falseDict = Nothing
    
    'Output 1 column after the last column to compare
    Dim outputColumn As Long
    outputColumn = firstColumn + numToCompare
        
    ws.Cells(firstRow, outputColumn).Resize(UBound(outputArr, 1)).Value = outputArr
End Sub

Answer 2

通过评估替代

假设单元格范围A2:E2中的单元格值，我演示了一种方法如何使用formula evaluation的结果（为具有值False的单元格显式获取列号数组） 和join 这些元素到想要的输出字符串。

公式"=Not(A2:E2)*Column(A2:E2)"背后的逻辑可以描述如下：

• A2:E2 ........ 获取布尔值 (true=1|false=0)，因为它们出现在指定的单元格中
• Not(A2:E2) ......... 替换（每个值由它的相反值：假~>真=1，真~>假=0）
• *Column(A2:E2)... 与单元格的列号相乘，因此仅对于具有原始 False 条目的单元格接收大于 0 的值（即，作为乘以因子 1 的结果的相应列号）。

最终的filtering 允许专门获取所需的列号，即没有零值。 Join 将找到的元素组合成一个结果输出字符串，最终可以写入第 6 列（c 部分）。

Option Explicit                          ' Force declaration of variables (head of code module)

Sub DetectFalseValues()
    Dim ws As Worksheet
    Set ws = Sheet1                      ' << change to required sheet Code(Name)
'a) get column numbers if original cell value equals False (negated as Not True);
'   (vice versa get zero for original True value after negation) 
    Dim allValues() As Variant
    allValues = ws.Evaluate("Not(A2:E2)*Column(A2:E2)")
'b) filter out all zero values and combine elements to string
    Dim output As String
    output = Join(Filter(allValues, 0, False), " and ")
    output = IIf(Len(output) = 0, "No Change", "Change in " & output)
'c) write to target
    ws.Range("F2").Value = output
    ''optional display in VB Editor's immediate window
    ' Debug.Print output                    ' e.g. "Change in 2 and 4"
End Sub