Tự học VBA ! Mọi người giúp em code tìm kiếm giống nhau và tô màu lại (1 người xem)

[fan.8051]

Tình hình là em tự mày mò VBA nên gặp nhiều khó khăn quá. Các bác giúp em viết cá code cho chương trình này giùm với ạ



Yêu cầu là: Tìm kiếm trong cột B2:B11 xem có dữ liệu nào trùng nhau thì tô màu lại đơn giản vậy thôi, ( ko dùng CF nhé).
Nói chung em cung có ý tưởng là:
1) Khai báo một mảng Temp, sau đó đưa tất cả dữ liệu từ ô B2 đến B11 vào mảng
2) FOR i=0 to kích thước mảng step + 1
mang gia trị Temp[0] đi so sán với các gia trị còn lại nếu giống nhau thi tô màu lại.

Em mới chập chững vô VBA nên chẳng biết thể hiện ý tưởng này ra làm sao nũa ! Hy vong các bác viết giùm em để em quen với cách viết, cách khai báo hay nhập, xuất trong VBa nó như thế nào ?

Thanks mọi người nhiều !

 

[mhung12005]

Tình hình là em tự mày mò VBA nên gặp nhiều khó khăn quá. Các bác giúp em viết cá code cho chương trình này giùm với ạ

View attachment 136249

Yêu cầu là: Tìm kiếm trong cột B2:B11 xem có dữ liệu nào trùng nhau thì tô màu lại đơn giản vậy thôi, ( ko dùng CF nhé).
Nói chung em cung có ý tưởng là:
1) Khai báo một mảng Temp, sau đó đưa tất cả dữ liệu từ ô B2 đến B11 vào mảng
2) FOR i=0 to kích thước mảng step + 1
mang gia trị Temp[0] đi so sán với các gia trị còn lại nếu giống nhau thi tô màu lại.

Em mới chập chững vô VBA nên chẳng biết thể hiện ý tưởng này ra làm sao nũa ! Hy vong các bác viết giùm em để em quen với cách viết, cách khai báo hay nhập, xuất trong VBa nó như thế nào ?

Thanks mọi người nhiều !

Theo mình bài này dùng Dic là đơn giản nhất

 

[fan.8051]

" Dic " là gì vậy bạn ?

 

[SA_DQ]

Thiệt tầm bậy hết biết cái anh chàng này!

[ThongBao]Theo mình bài này dùng Dic là đơn giản nhất[/Thongbao]

Chủ bài nói là mới học mà đã dụ người ta vô Dic rồi!
Theo mình, nếu thực sự bạn mới hộc thì ghi 1 macro như thế này xem sao:

B1: Chọn toàn bộ CSDL, & ;
B2 Xếp theo cột
Tạo 1 biến kiểu Long hay kiểu Range để duyệt toàn bộ dữ liệu có ở cột này từ đầu chí cuối (hay có thể từ cuối lên đầu)
Hễ gặp (duyệt từ đầu -> cuối) anh sắp gặp bằng dữ liệu với anh gặp thì tô màu anh đó; hay tô cả 2 anh 1 màu
Sau đó từ kết quả bạn suy luận cách mình sẽ đi tiếp!

Chúc thành công!

 

[giangleloi]

" Dic " là gì vậy bạn ?

Là cái này nè bạn
http://www.giaiphapexcel.com/forum/showthread.php?60643-Tổng-quan-về-Scripting-Dictionary

 

[fan.8051]

[ThongBao]Theo mình bài này dùng Dic là đơn giản nhất[/ThongBao]

Chủ bài nói là mới học mà đã dụ người ta vô Dic rồi!
Theo mình, nếu thực sự bạn mới hộc thì ghi 1 macro như thế này xem sao:

B1: Chọn toàn bộ CSDL, & ;
B2 Xếp theo cột
Tạo 1 biến kiểu Long hay kiểu Range để duyệt toàn bộ dữ liệu có ở cột này từ đầu chí cuối (hay có thể từ cuối lên đầu)
Hễ gặp (duyệt từ đầu -> cuối) anh sắp gặp bằng dữ liệu với anh gặp thì tô màu anh đó; hay tô cả 2 anh 1 màu
Sau đó từ kết quả bạn suy luận cách mình sẽ đi tiếp!

Chúc thành công!

Thú thật là em đọc mà mắt mủi hoa cả lên vì không tưởng tượng ra được, trước đây em hoc C, thì thấy rất đơn giản, chỉ việt vẽ thuật toán rồi bám vào đó là viết code, nay chuyển qua VBA e cung muốn làm theo trình tự như vậy, nên bác có thể viết cho em cái code sẳn được ko ?
Không phải là em nhác viết mà đơn giản em chỉ muốn xem cách bác khai báo như thế nào ? Đọc / ghi dữ liệu lên một range, cell như thế nào ?


hic , mong bác nhiệt tình giup đỡ, em chi khó khăn bước đầu này thôi

 

[giangleloi]

Thú thật là em đọc mà mắt mủi hoa cả lên vì không tưởng tượng ra được, trước đây em hoc C, thì thấy rất đơn giản, chỉ việt vẽ thuật toán rồi bám vào đó là viết code, nay chuyển qua VBA e cung muốn làm theo trình tự như vậy, nên bác có thể viết cho em cái code sẳn được ko ?
Không phải là em nhác viết mà đơn giản em chỉ muốn xem cách bác khai báo như thế nào ? Đọc / ghi dữ liệu lên một range, cell như thế nào ?


hic , mong bác nhiệt tình giup đỡ, em chi khó khăn bước đầu này thôi

Vô đây xem bài của Bác Sa đi bạn.
http://www.giaiphapexcel.com/forum/showthread.php?650-Chập-chững-đến-VBA!

 

[mhung12005]

Thú thật là em đọc mà mắt mủi hoa cả lên vì không tưởng tượng ra được, trước đây em hoc C, thì thấy rất đơn giản, chỉ việt vẽ thuật toán rồi bám vào đó là viết code, nay chuyển qua VBA e cung muốn làm theo trình tự như vậy, nên bác có thể viết cho em cái code sẳn được ko ?
Không phải là em nhác viết mà đơn giản em chỉ muốn xem cách bác khai báo như thế nào ? Đọc / ghi dữ liệu lên một range, cell như thế nào ?


hic , mong bác nhiệt tình giup đỡ, em chi khó khăn bước đầu này thôi

Chưa biết Dic là gì thì làm trên Range vậy:

Sub test1()   
   Dim rSrcRng As Range
   Dim lR As Long, i As Long
   Dim sTmp As String
   
   With Sheet1
      Set rSrcRng = .Range(.Range("B2"), .Range("B65000").End(xlUp))
      rSrcRng.Interior.ColorIndex = xlNone
      For lR = 1 To rSrcRng.Rows.Count
         sTmp = CStr(rSrcRng(lR, 1))
         If Len(sTmp) Then
            For i = lR + 1 To rSrcRng.Rows.Count
               If CStr(rSrcRng(i, 1)) = sTmp Then
                  rSrcRng(lR, 1).Interior.ColorIndex = 3
                  rSrcRng(i, 1).Interior.ColorIndex = 3
               End If
            Next i
         End If
      Next lR
   End With
   
End Sub

 

[comet_1701]

Tình hình là em tự mày mò VBA nên gặp nhiều khó khăn quá. Các bác giúp em viết cá code cho chương trình này giùm với ạ

View attachment 136249

Yêu cầu là: Tìm kiếm trong cột B2:B11 xem có dữ liệu nào trùng nhau thì tô màu lại đơn giản vậy thôi, ( ko dùng CF nhé).
Nói chung em cung có ý tưởng là:
1) Khai báo một mảng Temp, sau đó đưa tất cả dữ liệu từ ô B2 đến B11 vào mảng
2) FOR i=0 to kích thước mảng step + 1
mang gia trị Temp[0] đi so sán với các gia trị còn lại nếu giống nhau thi tô màu lại.

Em mới chập chững vô VBA nên chẳng biết thể hiện ý tưởng này ra làm sao nũa ! Hy vong các bác viết giùm em để em quen với cách viết, cách khai báo hay nhập, xuất trong VBa nó như thế nào ?

Thanks mọi người nhiều !

Sub mau()
Dim Sarr, Arr, i As Long, k As Long, Rng As Range, Tmp As String, cll As Range
Set Rng = Range([B2], [B65000].End(xlUp))
Sarr = Rng.Value
Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not dic.exists(Sarr(i, 1)) Then
            dic.Add Sarr(i, 1), 2
        Else
            dic.Item(Sarr(i, 1)) = dic.Item(Sarr(i, 1)) + 1
        End If
    Next
For Each cll In Rng
Tmp = cll.Value
If dic.Item(Tmp) > 1 Then
    cll.Interior.ColorIndex = dic.Item(Tmp)
End If
Next
Set dic = Nothing
End Sub

Bạn thử đoạn này xem được không

 

[mhung12005]

Sub mau()
Dim Sarr, Arr, i As Long, k As Long, Rng As Range, Tmp As String, cll As Range
Set Rng = Range([B2], [B65000].End(xlUp))
Sarr = Rng.Value
Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not dic.exists(Sarr(i, 1)) Then
            dic.Add Sarr(i, 1), 2
        Else
            dic.Item(Sarr(i, 1)) = dic.Item(Sarr(i, 1)) + 1
        End If
    Next
For Each cll In Rng
Tmp = cll.Value
If dic.Item(Tmp) > 1 Then
    cll.Interior.ColorIndex = dic.Item(Tmp)
End If
Next
Set dic = Nothing
End Sub

Bạn thử đoạn này xem được không

Không cần đến 2 vòng lặp đâu bạn comet_1701 ơi

Dic chỉ để kiểm tra thôi, nếu trùng thì tô màu luôn dòng duyệt đến và lấy cái item đã add lúc trước ra để làm chỉ số dòng trước để tô dòng đầu, chứ add thêm item vào chi nữa.
Chẳng hạn như này:

Sub test()   
   Dim Dic As Object
   Dim rSrcRng As Range, Arr
   Dim lR As Long
   Dim sTmp As String
   
   Set Dic = CreateObject("Scripting.Dictionary")
   With Sheet1
      Set rSrcRng = .Range(.Range("B2"), .Range("B65000").End(xlUp))
      Arr = rSrcRng.Value2
      rSrcRng.Interior.ColorIndex = xlNone
      For lR = 1 To UBound(Arr, 1)
         sTmp = CStr(Arr(lR, 1))
         If Not Dic.exists(sTmp) Then
            Dic.Add sTmp, lR
         Else
            rSrcRng(lR, 1).Interior.ColorIndex = 8
            rSrcRng(Dic.Item(sTmp), 1).Interior.ColorIndex = 8
         End If
      Next lR
   End With
   
End Sub

 

[VetMini]

Mới học VBA thì học cái căn bản nhất là còng lặp và Range. Đi rớ vào đít này đít nọ mất công bỏng tay.

Đáng lẽ thì bài này căn bản là dùng hai vòng lặp (như bài #8) để duyệt các tình trạng trùng. Nhưng viết code như vậy mất công bà con phê bình là không hiệu quả cho nên bài này tốt hơn hết là chủ thớt phải chịu khó học thêm cái cách gọi hàm worksheet.

1. Lập một vòng lặp, duyệt từng cell c của range rg
2. Gọi hàm WorksheetFunction.CountIf(rg, c)
3. nếu kết quả > 1 thì là có trùng lặp. Tô màu

Sub t()
[COLOR=#008000]' hàm tô màu cho các ô có dữ liệu trùng
[/COLOR]Set rg = Range("b2:b11")
For Each c In rg.Cells
If WorksheetFunction.CountIf(rg, c) > 1 Then c.Interior.ColorIndex = 3
Next c
End Sub

 

[comet_1701]

Không cần đến 2 vòng lặp đâu bạn comet_1701 ơi

Dic chỉ để kiểm tra thôi, nếu trùng thì tô màu luôn dòng duyệt đến và lấy cái item đã add lúc trước ra để làm chỉ số dòng trước để tô dòng đầu, chứ add thêm item vào chi nữa.
Chẳng hạn như này:

Sub test()   
   Dim Dic As Object
   Dim rSrcRng As Range, Arr
   Dim lR As Long
   Dim sTmp As String
   
   Set Dic = CreateObject("Scripting.Dictionary")
   With Sheet1
      Set rSrcRng = .Range(.Range("B2"), .Range("B65000").End(xlUp))
      Arr = rSrcRng.Value2
      rSrcRng.Interior.ColorIndex = xlNone
      For lR = 1 To UBound(Arr, 1)
         sTmp = CStr(Arr(lR, 1))
         If Not Dic.exists(sTmp) Then
            Dic.Add sTmp, lR
         Else
            rSrcRng(lR, 1).Interior.ColorIndex = 8
            rSrcRng(Dic.Item(sTmp), 1).Interior.ColorIndex = 8
         End If
      Next lR
   End With
   
End Sub

Em add để trùng 2 lần màu khác, trùng 3 lần màu khác, Học Thầy Ba tê, với lại tập viết luôn, Bác VetMini viết chuẩn nhất, lúc đầu em có hướng dùng countif or match

 

[comet_1701]

Sub test()
Dim rg As Range, c As Range
Set rg = Range("b2:b11")
For Each c In rg.Cells
    If WorksheetFunction.CountIf(rg, c) > 1 Then c.Interior.ColorIndex = 3
Next c
End Sub

Bạn khai báo thêm biến nhé, cách của bác VetMini là phù hợp với bạn roài

 

[Quang_Hải]

Viết bài này chạy 2 vòng For cho ai mới học sẽ thấy không ngán Dictionary

Sub tomau()
   Dim arr(), i As Long, Dic As Object
   arr = Range("B2", [B65536].End(3)).Value
   Set Dic = CreateObject("scripting.dictionary")
'Vòng 1 nạp vào Dic nếu em nào trùng thì đánh dấu lớn hơn 1
   For i = 1 To UBound(arr)
      Dic(arr(i, 1)) = Dic(arr(i, 1)) + 1
   Next
'Vòng 2 kiểm tra nếu thấy em nào được đánh dấu lớn hơn 1 thì tô màu
   For i = 1 To UBound(arr)
      If Dic(arr(i, 1)) > 1 Then
         Cells(i + 1, 2).Interior.ColorIndex = 6
      End If
   Next
End Sub

 

[HungQuoc49]

Tình hình là em tự mày mò VBA nên gặp nhiều khó khăn quá. Các bác giúp em viết cá code cho chương trình này giùm với ạ

View attachment 136249

Yêu cầu là: Tìm kiếm trong cột B2:B11 xem có dữ liệu nào trùng nhau thì tô màu lại đơn giản vậy thôi, ( ko dùng CF nhé).
Nói chung em cung có ý tưởng là:
1) Khai báo một mảng Temp, sau đó đưa tất cả dữ liệu từ ô B2 đến B11 vào mảng
2) FOR i=0 to kích thước mảng step + 1
mang gia trị Temp[0] đi so sán với các gia trị còn lại nếu giống nhau thi tô màu lại.

Em mới chập chững vô VBA nên chẳng biết thể hiện ý tưởng này ra làm sao nũa ! Hy vong các bác viết giùm em để em quen với cách viết, cách khai báo hay nhập, xuất trong VBa nó như thế nào ?

Thanks mọi người nhiều !

Thực hiện theo ý tưởng của đầu bài, cần bổ sung gì sẽ tính tiếp.

Public Sub Tu_Hoc()
Dim Temp, r As Long, rw As Long

Temp = Sheet1.Range("B2", "B11")
For r = 1 To UBound(Temp) - 1
For rw = r + 1 To UBound(Temp)

If Temp(r, 1) = Temp(rw, 1) Then
Sheet1.Range("B" & r + 1).Interior.ColorIndex = 6
Sheet1.Range("B" & rw + 1).Interior.ColorIndex = 6
End If

Next rw
Next r
End Sub

 

[hung2412]

Code:
[GPECODE=vb]Sub To_mau_1()
Dim Dic As Object
Dim i As Long
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To [B65536].End(xlUp).Row
If Not Dic.exists(Cells(i, 2).Value) Then
Dic.Add Cells(i, 2).Value, i 'i => Lấy số thứ tự của dòng làm Key
Else
Cells(i, 2).Interior.ColorIndex = 6 'Tô màu vàng cho ô này vì ô này đã thuộc từ điển
Range([B1], [B65536].End(xlUp))(Dic.Item(Cells(i, 2).Value)).Interior.ColorIndex = 6 'i ở đây là số thứ tự (Key)
End If
Next
End Sub[/GPECODE]

 

[phihndhsp]

Cây nhà lá vườn, không áp dụng bất cứ đối tượng nào có sẵn

Function KT_Trung(chuoi As String, Rng As Range) As Boolean
      Dim Flag As Boolean
      Dim Temp As Byte
           Flag = False
           Temp = 0
           For i = 1 To Rng.Count
               If (chuoi = Rng(i, 1).Value) Then
                     Temp = Temp + 1
                     If (Temp = 2)  Then
                           Flag = True
                           Exit For
                     End If
             End If
          Next
         KT_Trung = Flag
End Function

Sub GPE()
  Dim Rng As Range
  Dim i As Byte
  Set Rng = Sheet1.Range("B2:B11")
  For i = 2 To 12
    If (KT_Trung(Cells(i, 2).Value, Rng)) Then
        Cells(i, 2).Interior.ColorIndex = 6  
    End If
 Next
End Sub

 

[SA_DQ]

Góp vui cho thêm nhiều sặc sỡ

Option Explicit
Sub TìmTrùng()
 Dim Rng As Range, sRng As Range, Cls As Range, Rg0 As Range
 Dim J As Long, Rws As Long, MyColor As Byte
 
 Set Rng = Range([C2], [C2].End(xlDown))
 Rws = Rng.Rows.Count:          MyColor = 34
 For Each Cls In Rng
    Set Rg0 = Cls.Offset(1).Resize(Rws)
    Set sRng = Rg0.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        If Cls.Interior.ColorIndex < 9 Then
            Union(Cls, sRng).Interior.ColorIndex = MyColor
            If MyColor > 44 Then MyColor = 34 Else MyColor = MyColor + 1
        Else
            sRng.Interior.ColorIndex = Cls.Interior.ColorIndex
        End If
    End If
 Next Cls
End Sub

(Chỉ nên áp dụng cho danh sách lớn, như trường học, tổng công ti, các tiểu đoàn quân,. . . . )

 

[Quang_Hải]

Nếu đã nói đến cơ bản thì chẳng cần chi vòng lặp chi cho nhức mỏi
Muốn đơn giản thì phải đơn giản cho tới luôn.

Sub tomau()
Dim Lrow As Long, CT As String
Lrow = [B65536].End(3).Row
CT = "=Countif(R2C[-3]:R" & Lrow & "C[-3],RC[-3])"
With Range("B2", [B65536].End(3))
   With .Offset(, 3)
      .Formula = CT
      .AutoFilter 1, ">1"
      .Offset(, -3).SpecialCells(12).Interior.ColorIndex = 6
      .AutoFilter
      .ClearContents
   End With
End With
End Sub