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中依此类推..每个具有相同内容的文件块将在新行中列出问候

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

Answer 2

在2D数组中检查双精度的循环的快速示例：

Dim i As Long, k As Long

'Loop through the 2nd field of an array, these values are the "base" values
For i = LBound(arr, 1) To UBound(arr, 1)
    'Loop through the array again, these values will be checked against the base values for doubles
    For k = LBound(arr, 1) To UBound(arr, 1)
        'Check if the two records are the same (if they're not on the same iteration)
        If i <> k And arr(i, 1) = arr(k, 1) Then
             'Parse record in first field to sheet
             Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row, "A") = arr(i , 0)
        End If
    Next k
Next i

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

2 个答案: