此代码几乎可以正常工作。问题在于它的“匹配”结果中包含空白单元格。我需要更改什么才能使此代码忽略空白单元格?下面,我将提供一个例子说明发生了什么。
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提供到目前为止的代码和帮助!
我曾尝试使用您的原始代码,但老实说,我感到非常困惑。我在下面的示例将说明一些可能有用的做法(以及那些以后可能会查看您的代码的人,包括您自己!)。因此,这里是评论列表:
Option Explicit
。您的代码可能已经包含此代码,但出于完整性考虑,我在这里列出。根据问题描述,您需要标识每个唯一的项目,并跟踪找到该项目的行,以便以后创建报告。为此,Option Explicit
是一个完美的工具。 Dictionary
,但您应该可以在这里遵循此代码块的操作(即使没有前面的所有声明):
Read up about how to use a Dictionary
很容易看到这段代码的逻辑遵循问题的描述。之后,只需遍历数据区域的每一行并检查该行上的每个值,以查看是否在其他任何行上存在重复项。下面是完整的示例解决方案,供您研究和调整以适合您的情况。
Dictionary