Bandingkan beberapa kolom dalam dua lembar untuk mendapatkan nilai

Saya memiliki pengetahuan kerja terbatas tentang Excel VBA macro. Saya memiliki dua lembar yang disebut "Ringkasan" dan "Data"

• Lembar Ringkasan memiliki baris dan kolom yang diperbaiki.
• Lembar data memiliki nilai di dalamnya.

Saya perlu membandingkan Kode, nomor MRC Perusahaan dan Status Ringkasan dan lembar Data dan jika bidang cocok maka dapatkan nilai yang sesuai dari lembar Data ke bidang Ringkasan.

Solusi saya didasarkan pada Screen Shot terpasang , di mana saya menemukan hanya dua Kolom umum antara Lembar , yang

1. Kode

2. Perusahaan MRC

Saya tidak dapat menemukan bidang Status Ringkasan & Data.

Saya ingin menyarankan set Macro untuk membandingkan kedua Lembar untuk data umum untuk disalin ke Lembar lain.

Sub CompareRanges()

Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range

Set WorkRng1 = Application.InputBox("Range A:", "", Type:=8)
Set WorkRng2 = Application.InputBox("Range B:", Type:=8)

For Each Rng1 In WorkRng1
rng1Value = Rng1.Value

For Each Rng2 In WorkRng2

If rng1Value = Rng2.Value Then
Rng1.Interior.Color = VBA.RGB(255, 0, 0)
Exit For

End If
Next
Next

End Sub

Bagaimana itu bekerja:

1. Tanggapi kedua Kotak Input dengan Rentang Data yang sesuai dari kedua Lembar untuk dibandingkan.
2. Makro akan menyorot data duplikat di Lembar 1 (Lembar Data) dengan warna Merah .
3. JALANKAN Makro tertulis di bawah ini untuk Menyalin Data Duplikat.
4. Salin kedua Macro sebagai Modul Standar .

Diedit:

Lakukan hal berikut untuk menghindari penggunaan Makro kedua:

1. Pilih rentang data di DATA Sheet& terapkan Filter Otomatis .
2. Filter Baris dalam Warna Merah .
3. Salin Baris yang Difilter.

4. Tempatkan penunjuk Sel di Sel yang diperlukan & terapkan Pasta Khusus lalu Klik Nilai .

   Sub CopyRedRows()
   
   Dim wks As Worksheet
   Dim wNew As Worksheet
   Dim lRow As Long
   Dim lNewRow As Long
   Dim x As Long
   
   Set wks = Sheets("Data")
   lRow =  wks.Cells.SpecialCells(xlCellTypeLastCell).Row 
   
     Set wNew = Sheets("Summary")
     lNewRow = 10
   
     For x = 1 To lRow
       If wks.Cells(x, 1).Interior.Color = vbRed Then
         wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1)
         lNewRow = lNewRow + 1
       End If
     Next
   
   End Sub

5. Sheet Name, RGB Color Code& lNewRownilai dapat diedit.