Aqil Macro: Code untuk Membangdingkan (VBA-Macro)

Copy Code

'==========================

Sub CompareSheets()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim dict1 As Object, dict2 As Object
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long
    Dim key As Variant
    Dim row As Long
    
    ' Atur index sheet, misalkan Sheet1 = index 1, Sheet2 = index 2
    Set ws1 = ThisWorkbook.Sheets(1)
    Set ws2 = ThisWorkbook.Sheets(2)
    
    ' Buat Sheet3 jika belum ada
    On Error Resume Next
    Set ws3 = ThisWorkbook.Sheets(3)
    If ws3 Is Nothing Then
        Set ws3 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws3.Name = "Sheet3"
    End If
    On Error GoTo 0

' Hapus isi Sheet3 sebelum menulis hasil baru
    ws3.Cells.Clear
    
    ' Buat dictionary untuk menyimpan nomor dari sheet 1 dan 2
    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")
    
    ' Ambil data dari Sheet1
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow1 ' Mulai dari baris 2 karena baris 1 diasumsikan header
        If Not dict1.Exists(ws1.Cells(i, 1).Value) Then
            dict1.Add ws1.Cells(i, 1).Value, ws1.Cells(i, 2).Value
        End If
    Next i
    
    ' Ambil data dari Sheet2
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow2 ' Mulai dari baris 2 karena baris 1 diasumsikan header
        If Not dict2.Exists(ws2.Cells(i, 1).Value) Then
            dict2.Add ws2.Cells(i, 1).Value, ws2.Cells(i, 2).Value
        End If
    Next i
    
    ' Mulai menulis hasil ke Sheet3
    ws3.Cells(1, 1).Value = "Nomor"
    ws3.Cells(1, 2).Value = "Nama"
    ws3.Cells(1, 3).Value = "Status"
    row = 2
    
    ' Cek data yang ada di Sheet1 tapi tidak ada di Sheet2
    For Each key In dict1.Keys
        If Not dict2.Exists(key) Then
            ws3.Cells(row, 1).Value = key
            ws3.Cells(row, 2).Value = dict1(key)
            ws3.Cells(row, 3).Value = "Ada di Sheet1, tidak ada di Sheet2"
            row = row + 1
        End If
    Next key
    
    ' Cek data yang ada di Sheet2 tapi tidak ada di Sheet1
    For Each key In dict2.Keys
        If Not dict1.Exists(key) Then
            ws3.Cells(row, 1).Value = key
            ws3.Cells(row, 2).Value = dict2(key)
            ws3.Cells(row, 3).Value = "Ada di Sheet2, tidak ada di Sheet1"
            row = row + 1
        End If
    Next key
    
    ' Cek data yang ada di kedua Sheet
    For Each key In dict1.Keys
        If dict2.Exists(key) Then
            ws3.Cells(row, 1).Value = key
            ws3.Cells(row, 2).Value = dict1(key)
            ws3.Cells(row, 3).Value = "Ada di kedua Sheet"
            row = row + 1
        End If
    Next key

End Sub

'==========================

Aqil Macro

Home

Senin, 07 Oktober 2024

Code untuk Membangdingkan (VBA-Macro)

Tidak ada komentar:

Posting Komentar

Menghitung USIA Excel