如何在工作表中找到重複的值

Question

我有四個Excel工作表，其中有電影列表。我想比較第四張紙和前三張紙，並且只需要將普通電影寫入文本文件。或者可以在下一張紙上說。

Answer 1

我假設以下。如果適用，請更改。

1）的所有值都在第一列

2）表名稱是 「Sheet 1中」， 「Sheet 2中」， 「表Sheet 3」 和 「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