excel - 提取二维数组中的重复条目

Question

在下面的代码中，我可以将文本文件的内容存储在名为“TestFolder”的文件夹中，并且该数组有两列，一列用于文本文件名，另一列用于此文本文件的内容..

Sub Test()
Dim fso         As Object
Dim arr         As Variant
Dim lst         As Variant
Dim sFol        As String
Dim fld         As String
Dim fn          As String
Dim i           As Long

Set fso = CreateObject("Scripting.FileSystemObject")
sFol = ThisWorkbook.Path & "\TestFolder\"
fld = Chr(34) & sFol & "*.txt" & Chr(34)
lst = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c Dir " & fld & " /b /a-d").StdOut.ReadAll, vbCrLf), ".")
ReDim arr(1 To UBound(lst) + 1, 1 To 2)

fn = Dir(sFol & "*.txt")

Do While fn <> ""
    i = i + 1
    arr(i, 1) = fn
    arr(i, 2) = fso.OpenTextFile(sFol & fn).ReadAll
    fn = Dir
Loop
End Sub

我现在陷入如何循环遍历数组以检测具有相同内容的重复文本文件的问题，如果它们是相同的内容，我想在工作表中填充文件名

输出示例..假设 001.txt、003.txt 和 0051.txt(如果这三个文本文件具有相同的内容)，然后在 A1/B1/C1 中填充这些文件名依此类推..具有相同内容的每个文件 block 将在新行中列出问候

Answer 1

这是一个根据您的要求检查双倍的基本示例。

Option Explicit

Sub Sample()
    Dim arr As Variant
    Dim files As Variant
    Dim i As Long, j As Long, n As Long
    Dim filenames As String
    Dim matchfound As Boolean

    ReDim arr(1 To 6, 1 To 2)
    ReDim files(1 To 6)

    arr(1, 1) = "FileA": arr(1, 2) = "ContentA"
    arr(2, 1) = "FileB": arr(2, 2) = "ContentB"
    arr(3, 1) = "FileC": arr(3, 2) = "ContentC"
    arr(4, 1) = "FileD": arr(4, 2) = "ContentA"
    arr(5, 1) = "FileE": arr(5, 2) = "ContentB"
    arr(6, 1) = "FileF": arr(6, 2) = "ContentA"

    n = 1

    For i = LBound(arr) To UBound(arr)
        filenames = arr(i, 1)

        For j = LBound(arr) To UBound(arr)
            If i <> j Then
                If arr(i, 2) = arr(j, 2) Then
                    filenames = filenames & ";" & arr(j, 1)
                End If
            End If
        Next j

        For j = LBound(files) To UBound(files)
            If InStr(1, files(j), arr(i, 1)) > 0 Then
                matchfound = True
                Exit For
            End If
        Next j

        If matchfound = False Then
            If InStr(1, filenames, ";") > 0 Then _
            files(n) = filenames
            n = n + 1
        End If

        matchfound = False
    Next i

    For i = LBound(files) To UBound(files)
        Debug.Print files(i)
    Next i
End Sub

输出:

FileA;FileD;FileF
FileB;FileE