Question

我有四张Excel表格，我有电影列表。我想比较第四张和前三张，并且只需要将普通电影写入文本文件。或者可以在下一张表中说明。

Answer 1

我假设以下内容。请根据情况进行更改。

1）所有值都在第1列

2）工作表名称为“Sheet1”，“Sheet2”，“Sheet3”和“Sheet4”

3）必须将输出写入C：

中名为Sample.txt的文本文件

4）您将处理错误处理。

已经过测试

Option Explicit

Sub Sample()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim LastRow As Long, i As Long, n As Long
    Dim Ar() As String, strSearch As String, FlName As String
    Dim filesize As Integer

    '~~> Set your sheets here
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    Set ws3 = Sheets("Sheet3")
    Set ws4 = Sheets("Sheet4")

    '~~> Get LastRow of sheet 4
    LastRow = ws4.Range("A" & Rows.Count).End(xlUp).Row

    n = 0

    '~~> Loop through cells in Sheet4 to get the value to compare
    For i = 1 To LastRow
        strSearch = ws4.Range("A" & i).Value

        '~~> Check Sheets 1,2 and 3
        If Application.WorksheetFunction.CountIf(ws1.Columns(1), strSearch) > 0 Then
            '~~> Store it in an array
            n = n + 1: ReDim Preserve Ar(n): Ar(n) = strSearch
        ElseIf Application.WorksheetFunction.CountIf(ws2.Columns(1), strSearch) > 0 Then
            n = n + 1: ReDim Preserve Ar(n): Ar(n) = strSearch
        ElseIf Application.WorksheetFunction.CountIf(ws3.Columns(1), strSearch) > 0 Then
            n = n + 1: ReDim Preserve Ar(n): Ar(n) = strSearch
        End If
    Next i

    '~~> Write to Text File. Change path as applicable
    FlName = "C:\Sample.Txt"

    '~~> Get a free file handle
    filesize = FreeFile()

    '~~> Open your file
    Open FlName For Output As #filesize

    '~~> Export Text
    For i = 1 To UBound(Ar)
        Print #filesize, Ar(i)
    Next i

    Close #filesize
End Sub

如何在工作表中查找重复值

1 个答案: