シートで重複する値を見つける方法

Question

私は映画のリストを持っている4つのExcelシートを持っています。私は最初の3枚と4枚目のシートを比較し、共通の映画だけをテキストファイルに書き込む必要があります。または次のシートで言うことができます。

Answer 1

私は以下のことを想定しています。該当する場合は変更してください。すべての値は、1列目にある

1）

2）シート名は

3）出力が書き込まれた「シート1」、「シート2」、「シート3」と「シート4」ですC：

4）あなたはエラー処理の世話をします。

を使用すると、式やVBAコードが必要です試してみました

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