我需要这种匹配方法来跳过空白单元格,而不将它们包含为匹配值

问题描述 投票:0回答:1

此代码几乎可以正常工作。问题在于它的“匹配”结果中包含空白单元格。我需要更改什么才能使此代码忽略空白单元格?下面,我将提供一个例子说明发生了什么。

enter image description here

Sub MarkMatches()
    Const TopLeftCell As String = "A2"      ' change to match where your data are

    Dim Rng As Range                        ' data range
    Dim FirstRow As Long, FirstClm As Long
    Dim Data As Variant                     ' original data (2-D)
    Dim Arr As Variant                      ' data rearranged (1-D)
    Dim Tmp As Variant                      ' working variable
    Dim R As Long, R1 As Long               ' row counters
    Dim C As Long                           ' column counter
    Dim Count() As String                   ' match counter

    With Range(TopLeftCell)
        FirstRow = .Row
        FirstClm = .Column
    End With
    C = Cells(FirstRow, Columns.Count).End(xlToLeft).Column
    Set Rng = Range(Cells(FirstRow, FirstClm), _
                    Cells(Rows.Count, FirstClm).End(xlUp).Offset(0, C - FirstClm))
    Data = Rng.Value

    ReDim Arr(1 To UBound(Data))
    For R = 1 To UBound(Data)
        ReDim Tmp(1 To UBound(Data, 2))
        For C = 1 To UBound(Data, 2)
            Tmp(C) = Data(R, C)
        Next C
        Arr(R) = Tmp
    Next R

    ReDim Count(1 To UBound(Arr))
    For R = 1 To UBound(Arr) - 1
        For R1 = R + 1 To UBound(Arr)
            Tmp = 0
            For C = 1 To UBound(Arr(R))
                If Not IsError(Application.Match(Arr(R)(C), Arr(R1), 0)) Then
                    Tmp = Tmp + 1
                End If
            Next C
            If Tmp > 0 Then                 ' change to suit
                Tmp = Format(Tmp, "(0)") & ", "
                Count(R) = Count(R) & CStr(R1 + FirstRow - 1) & Tmp
                Count(R1) = Count(R1) & CStr(R + FirstRow - 1) & Tmp
            End If
        Next R1
    Next R

    For R = 1 To UBound(Count)
        If Len(Count(R)) Then Count(R) = Left(Count(R), Len(Count(R)) - 2)
    Next R
    ' set the output column here (2 columns right of the last data column)
    '   to avoid including this column in the evaluation
    '   it must be blank before a re-run
    Set Rng = Rng.Resize(, 1).Offset(0, UBound(Data, 2) + 1)
    Rng.Value = Application.Transpose(Count)
End Sub

感谢@Variatus提供到目前为止的代码和帮助!

excel vba sorting match matching
1个回答
0
投票

我曾尝试使用您的原始代码,但老实说,我感到非常困惑。我在下面的示例将说明一些可能有用的做法(以及那些以后可能会查看您的代码的人,包括您自己!)。因此,这里是评论列表:

  1. Always use Option Explicit。您的代码可能已经包含此代码,但出于完整性考虑,我在这里列出。
  2. 创建描述变量名称的变量名。您的代码可以做到这一点,但是某些变量名很难放入逻辑流程中。我在编码中的想法始终是尝试编写自记录代码。这样,几乎总是很清楚代码试图完成什么。然后,我将在代码块中使用注释,但可能不太清楚。 (不要陷入用“类型”之类的变量名开头的陷阱;这最终是不值得的。)
  3. 清楚描述问题总是有帮助的。这不仅是在SO方面获得帮助,对于您自己也是如此。对于您上面的帖子,我对问题描述的最后评论确实简化了一切。这包括描述您希望输出显示的内容。

根据问题描述,您需要标识每个唯一的项目,并跟踪找到该项目的行,以便以后创建报告。为此,Option Explicit是一个完美的工具。 Dictionary,但您应该可以在这里遵循此代码块的操作(即使没有前面的所有声明):

Read up about how to use a Dictionary

很容易看到这段代码的逻辑遵循问题的描述。之后,只需遍历数据区域的每一行并检查该行上的每个值,以查看是否在其他任何行上存在重复项。下面是完整的示例解决方案,供您研究和调整以适合您的情况。

Dictionary
© www.soinside.com 2019 - 2024. All rights reserved.