Note: The other languages of the website are Google-translated. Back to English

Bagaimana cara menyorot nilai duplikat dalam berbagai warna di Excel?

doc berbeda warna duplikat 1

Di Excel, kita dapat dengan mudah menyorot nilai duplikat dalam kolom dengan satu warna dengan menggunakan Format Bersyarat, tetapi, terkadang, kita perlu menyorot nilai duplikat dalam warna berbeda untuk mengenali duplikat dengan cepat dan mudah seperti gambar berikut yang ditampilkan. Bagaimana Anda bisa menyelesaikan tugas ini di Excel?

Sorot nilai duplikat dalam kolom dengan warna berbeda menggunakan kode VBA


panah gelembung kanan biru Sorot nilai duplikat dalam kolom dengan warna berbeda menggunakan kode VBA

Sebenarnya, tidak ada cara langsung bagi kami untuk menyelesaikan pekerjaan ini di Excel, tetapi, kode VBA di bawah ini dapat membantu Anda, lakukan hal berikut:

1. Pilih kolom nilai yang ingin Anda sorot duplikat dengan warna berbeda, lalu tahan ALT + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Klik Menyisipkan > Modul, dan tempel kode berikut di Modul Jendela.

Kode VBA: Sorot nilai duplikat dalam berbagai warna:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

3. Lalu tekan F5 kunci untuk menjalankan kode ini, dan kotak prompt akan mengingatkan Anda untuk memilih rentang data yang ingin Anda sorot nilai duplikat, lihat tangkapan layar:

doc berbeda warna duplikat 2

4. Lalu klik OK tombol, semua nilai duplikat telah disorot dalam warna berbeda, lihat tangkapan layar:

doc berbeda warna duplikat 1


Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda hingga 80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari 300 fitur canggih. Mendukung Office / Excel 2007-2021 dan 365. Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap Uji coba gratis 30 hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (91)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
Ini bekerja untuk saya pada daftar nomor bagian.
Komentar ini diminimalkan oleh moderator di situs
Halo,

Apakah ada cara untuk membuat ini hanya memengaruhi kolom yang disorot dan bukan seluruh baris? Beberapa warna merah dan biru yang berani sulit dilihat di seluruh spreadsheet. terima kasih
Komentar ini diminimalkan oleh moderator di situs
Ini saja yang saya butuhkan, terima kasih. Terkadang ketika saya menjalankan kode ini, Excel hanya membeku, saya menggunakan Office 2016 / Windows 10, tahu mengapa?
Komentar ini diminimalkan oleh moderator di situs
Patrick, hanya sorot sel yang Anda inginkan. Jangan sorot seluruh kolom yang akan mencakup ribuan sel kosong
Komentar ini diminimalkan oleh moderator di situs
saya ingin memeriksa duplikat untuk 5000 sel yang tidak dapat saya lakukan. saya dapat menyorot duplikat hingga 70 hingga 80 sel
Komentar ini diminimalkan oleh moderator di situs
Sub BuscarD()
Redupkan xRg Sebagai Rentang
Redupkan xTxt Sebagai String
Redupkan xCell Sebagai Rentang
Redupkan xChar Sebagai String
Redupkan xCellPre Sebagai Rentang
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
Redupkan J Sebagai Integer
Dim K Sebagai Integer
Redupkan xCLR Sebagai Integer

xCLR = 28

On Error Resume Next
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Seleccione el range a evaluar:", "Buscar duplicados", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
J = 0
K = 0
Tetapkan xCol = Koleksi Baru
Untuk Setiap xCell Dalam xRg
On Error Resume Next
xCol.Tambahkan xCell, xCell.Teks
Jika Err.Number = 457 Maka
Setel xCellPre = xCol(xCell.Text)
Jika xCellPre.Interior.ColorIndex = xlNone Maka
xCellPre.Interior.Warna = RGB(255, J, K)
xCell.Interior.Warna = RGB(255, J, K)
Jika K + xCLR <= 255 Maka
K = K + xClR
Lain
Jika J + xCLR <= 255 Maka
K = 0
J = J + xClR
Lain
MsgBox "!Demasiados datos duplicados!: Redusir variabel xCLR", vbCritical, "Error"
Keluar dari Sub
End If
End If
Lain
xCell.Interior.Color = xCellPre.Interior.Color
End If
LainJika Err.Number = 9 Maka
MsgBox "Demasiados datos duplicados!", vbCritical, "Error"
Keluar dari Sub
End If
Pada Kesalahan GoTo 0
Next

End Sub

Es un tema viejo, pero lo dejo por si alguien lo necesita. Con el código anterior y modificando la variable "xCLR", desde 1 a 255, se pueden obtener desde 4 hasta 65.000 colores diferentes. En mi caso, configuré el rojo del RGB con un valor estático de 255 y varío los valores verde y azul (255, X, X). Si se requieren mas colores, se podría alterar el valor del rojo, logrando mas de 166 millones de colores diferentes
Komentar ini diminimalkan oleh moderator di situs
Ini telah menjadi penyelamat hidup saya, terima kasih banyak telah berbagi! Ketika saya menjalankannya di sekitar 2000 sel dengan nilai, itu hanya menyoroti beberapa duplikat. Apakah ada cara untuk memperbaikinya? Aku ingin tahu apakah itu kehabisan warna atau ada sesuatu yang lain.
Komentar ini diminimalkan oleh moderator di situs
masalah yang sama saya coba dengan beberapa ratus sel dan sangat cepat warnanya dalam warna yang sama. apakah ada perbaikan untuk ini? terima kasih
Komentar ini diminimalkan oleh moderator di situs
Permasalahan yang sama. Ada yang tahu ini?
Komentar ini diminimalkan oleh moderator di situs
Saya memiliki masalah yang sama, masalahnya adalah indeks warna hanya menjadi 56, jadi setelah melewati itu tidak lagi mewarnai sel. Untuk memperbaikinya, saya mengganti baris "xCIndex = xCIndex + 1" dengan yang berikut: If xCIndex > 55 Then xCIndex = 3 Else xCIndex = xCIndex + 1 End If Ini akan mulai menggunakan kembali warna pada akhirnya, tetapi itu tidak menjadi masalah bagi Saya.
Komentar ini diminimalkan oleh moderator di situs
Ganti dengan If xCIndex > 55 Kemudian xCIndex = 3 Else xCIndex = xCIndex + 1 End If Tidak berfungsi. Mencoba membuatnya berfungsi pada 14000 baris, kira-kira 6000 duplikat
Komentar ini diminimalkan oleh moderator di situs
Ini berhasil untuk saya, saya menjorok baris kedua dan keempat. Lihat di bawah. Kode Josh dicetak tebal.

Jika Err.Number = 457 Maka
Jika xCIndex > 55 Maka
xCIndeks = 3
Lain
xCIndex = xCIndeks + 1
End If
Setel xCellPre = xCol(xCell.Text)
Komentar ini diminimalkan oleh moderator di situs
Terima kasih banyak, Josh, berhasil!
Komentar ini diminimalkan oleh moderator di situs
Ini bekerja SEMPURNA!! Terima kasih. Saya kehilangan akal untuk mencari solusi. Menghargai Anda.
Komentar ini diminimalkan oleh moderator di situs
Saya mencoba menjalankan ini beberapa kali dan setiap kali saya mengklik "ok" itu hanya mengirim saya kembali ke layar modul. Saya menggunakan Excel 2010.
Komentar ini diminimalkan oleh moderator di situs
Ini bagus dan PERSIS apa yang saya cari! Saya memasukkan kode ini ke dalam beberapa kode yang ada - saya telah menulis kode saya untuk memilih sel yang ingin saya warnai, dan kemudian saya memanggil kode tersebut untuk melakukan pewarnaan. Satu-satunya hal yang saya tidak tahu adalah bagaimana melewati msgBox yang muncul dan saya harus mengklik OK. Saya seorang pemula di VBA dan tidak tahu cara mengubah kode ini.... Ada saran, tolong! :)
Komentar ini diminimalkan oleh moderator di situs
Ganti baris: Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
untuk
Tetapkan xRg = Rentang("A1:A100")

atau jika Anda memiliki tabel, Anda dapat menerapkan ke seluruh kolom tabel:
Tetapkan xRg = Range("Tabel1[[#Semua],[Kolom1]]")

cukup ganti Table1 ke nama Anda sendiri dan Column1 ke header tabel mana pun yang ingin Anda terapkan makro ini.


Salam
Wojciech
Komentar ini diminimalkan oleh moderator di situs
Saya sangat senang karena saya mendapatkan apa yang saya butuhkan. terima kasih
Komentar ini diminimalkan oleh moderator di situs
bagaimana cara mengubah warna?
Komentar ini diminimalkan oleh moderator di situs
Hai,
Kode hanya dapat membantu Anda menambahkan warna yang berbeda secara acak, tidak dapat mengubah warna.
Terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Tampaknya selalu menggunakan palet warna yang sama, apakah ada cara untuk memilih palet yang digunakannya? Ini memberi saya beberapa warna yang sangat gelap di mana teks tidak dapat dibaca.
Komentar ini diminimalkan oleh moderator di situs
masalah yang sama dengan saya ... warnanya terlalu gelap untuk dibaca ...
Komentar ini diminimalkan oleh moderator di situs
tanpa kosong untuk mengubah warna bagaimana ????????????????????
Komentar ini diminimalkan oleh moderator di situs
Halo, gopi,
Untuk menghindari sel kosong, silakan terapkan kode VBA berikut:
Sub ColorCompanyDuplikat()
'Perbarui oleh Extendoffice 20171222
Redupkan xRg Sebagai Rentang
Redupkan xTxt Sebagai String
Redupkan xCell Sebagai Rentang
Redupkan xChar Sebagai String
Redupkan xCellPre Sebagai Rentang
Redupkan xCIndex Selamanya
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
On Error Resume Next
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
xCIndeks = 2
Tetapkan xCol = Koleksi Baru
Untuk Setiap xCell Dalam xRg
On Error Resume Next
Jika xCell.Value <> "" Maka
xCol.Tambahkan xCell, xCell.Teks
Jika Err.Number = 457 Maka
xCIndex = xCIndeks + 1
Setel xCellPre = xCol(xCell.Text)
Jika xCellPre.Interior.ColorIndex = xlNone Maka xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
LainJika Err.Number = 9 Maka
MsgBox "Terlalu banyak duplikat perusahaan!", vbCritical, "Kutools for Excel"
Keluar dari Sub
End If
Pada Kesalahan GoTo 0
End If
Next
End Sub

Semoga bisa membantu Anda, terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Pak,
Bagaimana membedakan warna berbeda yang diberikan dalam data berdasarkan frekuensi?
Dalam data yang sangat besar warna yang sama telah diberikan berulang kali tanpa mempertimbangkan frekuensinya.
Komentar ini diminimalkan oleh moderator di situs
Maaf, dapatkah Anda memberikan informasi lebih rinci, Anda dapat melampirkan tangkapan layar di sini.
Terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Halo, saya punya Excel 2016, alt+F11 apakah berfungsi lagi untuk membuka Microsoft VB? adalah perangkat lunak gratis Microsoft visual basic? Terima kasih.
Komentar ini diminimalkan oleh moderator di situs
Hai,
Jika Anda tidak dapat mengaktifkan jendela Microsoft VB dengan menahan tombol Alt + F11, Anda dapat mengklik Pengembang > Visual Basic untuk membukanya.

Silakan dicoba, terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Bagaimana Jika saya hanya ingin mengisi dengan dua warna saja, misalkan kuning dan merah, berulang-ulang. Untuk lebih jelasnya, pada contoh di halaman ini, 'Rachel' berwarna kuning, Rose berwarna merah dan lagi Sussies berwarna kuning, Tedi berwarna merah.
Komentar ini diminimalkan oleh moderator di situs
Halo, selim,
Kode berikut dapat memecahkan masalah Anda, silakan coba.

Sub ColorCompanyDuplikat()
'Perbarui oleh Extendoffice 20170504
Redupkan xRg Sebagai Rentang
Redupkan xTxt Sebagai String
Redupkan xCell Sebagai Rentang
Redupkan xChar Sebagai String
Redupkan xCellPre Sebagai Rentang
Redupkan xRgTemp Sebagai Rentang
Redupkan xCIndex Selamanya
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
On Error Resume Next
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
xCIndeks = 3
Tetapkan xCol = Koleksi Baru
Untuk Setiap xCell Dalam xRg
On Error Resume Next
xCol.Tambahkan xCell, xCell.Teks
Jika Err.Number = 457 Maka
Setel xCellPre = xCol(xCell.Text)
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
LainJika Err.Number = 9 Maka
MsgBox "Terlalu banyak duplikat perusahaan!", vbCritical, "Kutools for Excel"
Keluar dari Sub
Lain
xCell.Interior.ColorIndex = xCIndex
Tetapkan xRgTemp = xCell
xCIndex = IIf(xRgTemp.Interior.ColorIndex = 3, 4, 3)
End If
Pada Kesalahan GoTo 0
Next
End Sub

Semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
Inilah yang sebenarnya saya inginkan. Terima kasih banyak, skyyang.
Komentar ini diminimalkan oleh moderator di situs
Apakah ada cara untuk menyorot seluruh baris alih-alih 1 kolom?
Komentar ini diminimalkan oleh moderator di situs
Hai, Boboi,
Untuk menyorot seluruh baris berdasarkan nilai sel duplikat, Anda dapat menerapkan kode VBA berikut:

Sub ColorCompanyDuplikat()
Redupkan xRg Sebagai Rentang
Redupkan xTxt Sebagai String
Redupkan xCell Sebagai Rentang
Redupkan xChar Sebagai String
Redupkan xCellPre Sebagai Rentang
Redupkan xCIndex Selamanya
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
On Error Resume Next
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
xCIndeks = 2
Tetapkan xCol = Koleksi Baru
Untuk Setiap xCell Dalam xRg
On Error Resume Next
xCol.Tambahkan xCell, xCell.Teks
Jika Err.Number = 457 Maka
xCIndex = xCIndeks + 1
Setel xCellPre = xCol(xCell.Text)
Jika xCellPre.Interior.ColorIndex = xlNone Maka xCellPre.EntireRow.Interior.ColorIndex = xCIndex
xCell.EntireRow.Interior.ColorIndex = xCellPre.EntireRow.Interior.ColorIndex
LainJika Err.Number = 9 Maka
MsgBox "Terlalu banyak duplikat perusahaan!", vbCritical, "Kutools for Excel"
Keluar dari Sub
End If
Pada Kesalahan GoTo 0
Next
End Sub

Silakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
bagaimana saya bisa menyorot rentang baris?
Komentar ini diminimalkan oleh moderator di situs
Halo, Hossein,
Mungkin kode berikut dapat membantu Anda, silakan coba.

Sub ColorCompanyDuplikat()
'Perbarui oleh Extendoffice
Redupkan xRg, xRgRow Sebagai Rentang
Redupkan xTxt, xStr Sebagai String
Redupkan xCell, xCellPre Sebagai Rentang
Redupkan xCIndex Selamanya
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
xCIndeks = 2
Tetapkan xCol = Koleksi Baru
Untuk I = 1 Ke xRg.Rows.Count
On Error Resume Next
Tetapkan xRgRow = xRg.Rows(I)
Untuk Setiap xCell Dalam xRgRow.Columns
xStr = xStr & xCell.Teks
Next
xCol.Tambahkan xRgRow, xStr
Jika Err.Number = 457 Maka
xCIndex = xCIndeks + 1
Tetapkan xCellPre = xCol(xStr)
Jika xCellPre.Interior.ColorIndex = xlNone Maka xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
LainJika Err.Number = 9 Maka
MsgBox "Terlalu banyak duplikat perusahaan!", vbCritical, "Kutools for Excel"
Keluar dari Sub
End If
Pada Kesalahan GoTo 0
xStr = ""
Next
End Sub
Komentar ini diminimalkan oleh moderator di situs
Luar biasa!! Ini sangat membantuku!
Dan jika saya perlu menyoroti yang tunggal juga? Bagaimana saya bisa melakukannya?
Komentar ini diminimalkan oleh moderator di situs
Halo, Carla

Untuk menyorot baris termasuk yang unik, harap terapkan kode VBA di bawah ini:
Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim xOnlyIndex
Dim I As Long
If ActiveWindow.RangeSelection.Count > 1 Then
    xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
    xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For I = 1 To xRg.Rows.Count
    On Error Resume Next
    Set xRgRow = xRg.Rows(I)
    For Each xCell In xRgRow.Columns
        xStr = xStr & xCell.Text
    Next
    xCol.Add xRgRow, xStr
    If err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xStr)
        If xCellPre.Interior.ColorIndex = xlNone Then
            xCellPre.Interior.ColorIndex = xCIndex
        Else            
        End If
        xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
    ElseIf err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
    End If    
    On Error GoTo 0
    xStr = ""
Next
For Each xCellPre In xCol
    If xCellPre.Interior.ColorIndex = xlNone Then
        xCIndex = xCIndex + 1
        xCellPre.Interior.ColorIndex = xCIndex
    End If
Next
End Sub

Silakan dicoba, semoga bisa membantu Anda!
Komentar ini diminimalkan oleh moderator di situs
Ya skyyang! Kamu keren!
Bisakah kita menyorot seluruh baris, bukan hanya kolom?

Maaf jika saya mengganggu, tetapi Anda benar-benar banyak membantu saya!
Komentar ini diminimalkan oleh moderator di situs
Halo, Caria,
Jika Anda perlu menyorot seluruh baris, Anda hanya perlu memilih seluruh rentang baris saat memilih rentang data di kotak dialog yang muncul.
Silakan coba, terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Maaf, saya tidak bisa
Saya pikir itu tidak benar karena kode berfungsi di kolom dan ketika saya memilih baris, mereka disorot, tetapi tidak mengikuti kriteria sebelumnya.

Kode yang Anda bagikan sebelumnya, hanya untuk duplikat, berfungsi dengan baik.
Komentar ini diminimalkan oleh moderator di situs
Apakah ada cara untuk mengubah skrip agar berfungsi (lihat) array tabel alih-alih kolom? Misalnya F2:BC117.
Terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Halo, Vasil,
Untuk menyorot nilai duplikat dalam rentang sel, silakan coba kode vba berikut:

Sub ColorCompanyDuplikat()
'Perbarui oleh Extendoffice
Redupkan xRg, xRgRow Sebagai Rentang
Redupkan xTxt, xStr Sebagai String
Redupkan xCell, xCellPre Sebagai Rentang
Redupkan xCIndex Selamanya
Redupkan xCol Sebagai Koleksi
Redup Aku Selamanya
Jika ActiveWindow.RangeSelection.Count > 1 Kemudian
xTxt = ActiveWindow.RangeSelection.AddressLocal
Lain
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("silakan pilih rentang data:", "Kutools for Excel", xTxt, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
xCIndeks = 2
Tetapkan xCol = Koleksi Baru
Untuk I = 1 Ke xRg.Rows.Count
On Error Resume Next
Tetapkan xRgRow = xRg.Rows(I)
Untuk Setiap xCell Dalam xRgRow.Columns
xStr = xStr & xCell.Teks
Next
xCol.Tambahkan xRgRow, xStr
Jika Err.Number = 457 Maka
xCIndex = xCIndeks + 1
Tetapkan xCellPre = xCol(xStr)
Jika xCellPre.Interior.ColorIndex = xlNone Maka xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
LainJika Err.Number = 9 Maka
MsgBox "Terlalu banyak duplikat perusahaan!", vbCritical, "Kutools for Excel"
Keluar dari Sub
End If
Pada Kesalahan GoTo 0
xStr = ""
Next
End Sub

Semoga dapat membantu Anda.
Komentar ini diminimalkan oleh moderator di situs
Saya baru mengenal VBA. Apakah ada cara, bahwa kita tidak perlu menjalankan makro berulang-ulang, itu otomatis untuk menyorot bahkan jika sel baru disalin ke kolom tempat makro diprogram?
Komentar ini diminimalkan oleh moderator di situs
Ini sangat bagus, tetapi pewarnaan berhenti setelah baris 66 (9 warna). Bagaimana ini bisa diperpanjang?
Komentar ini diminimalkan oleh moderator di situs
Halo, Anri,
Kode di atas berfungsi dengan baik di lembar kerja saya, saya mengujinya dalam 300 ratus baris.
Silakan coba lagi. Atau Anda dapat mengirim file buku kerja Anda ke akun email saya.
Akun email saya adalah: skyyang@extendoffice.com
Komentar ini diminimalkan oleh moderator di situs
ada beberapa kesalahan mengenai pengaturan colorindex, xCindex akan lebih dari 56 jika ada 56 data baris di lembar Anda, sistem akan mengabaikan kalimat:
Jika xCellPre.Interior.ColorIndex = xlNone Maka xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
Saya memperbaiki program seperti di bawah ini: \
jika Err.number=457 maka
jika xCellPre.Text<>xCell.Text Kemudian
xCindex=xCindeks+1
endif
mengatur.....
Komentar ini diminimalkan oleh moderator di situs
Halo,
lembar excel saya memiliki 11000 baris data.
bagaimana saya bisa memperluasnya untuk menyorot semua duplikat di kolom panjang itu.

itu berhenti di baris 77.

Terima kasih,

AK
Komentar ini diminimalkan oleh moderator di situs
Ini sangat bagus, tetapi pewarnaan berhenti setelah baris 76 (5 warna). Bagaimana saya ini bisa diperpanjang juga?
Komentar ini diminimalkan oleh moderator di situs
Spreadsheet saya juga berhenti mewarnai pada 178 dan saya memiliki lebih dari 400 baris. Bagaimana Anda memperbaiki ini?
Komentar ini diminimalkan oleh moderator di situs
Halo, Karol,
Bisakah Anda mengirim buku kerja Anda ke alamat email saya, saya dapat membantu Anda menemukan masalahnya.
Alamat email saya adalah :skyyang@extendoffice.com
Belum ada komentar yang diposting di sini
Muat Lebih
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan

Ikuti kami

Hak Cipta © 2009 - www.extendoffice.com. | Seluruh hak cipta. Dipersembahkan oleh ExtendOffice. | Peta Situs
Microsoft dan logo Office adalah merek dagang atau merek dagang terdaftar dari Microsoft Corporation di Amerika Serikat dan / atau negara lain.
Dilindungi oleh Sectigo SSL