Tìm vùng dữ liệu giống nhau trên 1 dòng (3 người xem)

[binhnguyenthanh]

Tôi có một bài toán rất khó khăn mong được mọi người giúp đỡ. Yêu cầu có ghi trong File đính kèm. Thanks mọi người trước!

 

[SA_DQ]

Còn vấn đề gì đó chưa ổn lắm, xài tạm trong khi chờ hoàn thiện

Option Explicit
Sub TrungDL()
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim cRng As Range, Rng1 As Range:     Dim Khong As Boolean
 Dim MyAdd As String:                  Dim Rw As Long, jJ As Byte, Cot As Byte
 
 Set cRng = Selection:                 Set Rng1 = cRng.Cells(1, 1)
 Rw = cRng.Row:                        Cot = cRng.Columns.Count
 Set Rng = Range(Cells(Rw, "A"), Cells(Rw, Cells(Rw, "iV").End(xlToLeft).Column))
 Set Rng = Cells(Rw, "A").Resize(, Rng.Columns.Count + Cot)
 Rng.Interior.ColorIndex = 0
 Set sRng = Rng.Find(Rng1.Value, Rng1, xlFormulas, xlWhole)
 If sRng Is Nothing Then
   MsgBox "Khong Có Vùng Giong Vay Trong Hàng"
 Else
   MyAdd = sRng.Address
   Do
      For Each Clls In cRng
         If Clls.Value <> sRng.Offset(, jJ).Value Then
            Khong = Not Khong:         Exit For
         End If
         jJ = jJ + 1
      Next Clls
      If Khong Then
         Khong = Not Khong:            jJ = 0
      Else
         sRng.Resize(, Cot).Interior.ColorIndex = 35 + Rw Mod 6
      End If
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   MsgBox sRng.Address
 End If
End Sub

 

[binhnguyenthanh]

Thanks bạn nhiều.

Tôi mới tìm hiểu VBA nên chưa hiểu đoạn mã trên lắm. Bạn có thể giải thích một chút không? Và cả thuật toán nữa.

 

[binhnguyenthanh]

Cuối cùng cũng có kết quả. Thanks mọi người

Option Explicit
Private Sub CommandButton1_Click()
Dim Rng As Range, sRng As Range, Clls As Range
Dim cRng As Range, Rng1 As Range: Dim Khong As Boolean
Dim MyAdd As String: Dim Rw As Long, jJ As Byte, Cot As Byte, TAM As Byte

Set cRng = Selection: Set Rng1 = cRng.Cells(1, 1)
Rw = cRng.Row: Cot = cRng.Columns.Count
Set Rng = Range(Cells(Rw, "A"), Cells(Rw, Cells(Rw, "iV").End(xlToLeft).Column))
Set Rng = Cells(Rw, "A").Resize(, Rng.Columns.Count + Cot)
Rng.Interior.ColorIndex = 0
Set sRng = Rng.Find(Rng1.Value, Rng1, xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Khong Có Vùng Giong Vay Trong Hàng"
Else
MyAdd = sRng.Address
Do

For Each Clls In cRng
If Clls.Value <> sRng.Offset(, jJ).Value Then
Khong = Not Khong
jJ = 0
Exit For
End If
jJ = jJ + 1
TAM = jJ
Next Clls
If TAM = Cot Then
sRng.Resize(, Cot).Interior.ColorIndex = 35 + Rw Mod 6
jJ = 0
End If
Set sRng = Rng.FindNext(sRng)
Loop While sRng.Address <> MyAdd
End If
End Sub

 

[ChanhTQ@]

From BinhNguyenThanh:Tôi mới tìm hiểu VBA nên chưa hiểu đoạn mã trên lắm. Bạn có thể

Option Explicit  'Yêu cầu các biến cần xài phải được khai báo'
Private Sub CommandButton1_Click()   'Macro của nút nhấn'
' 3 dòng tiếp sau là khai báo những biến cần dùng'
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim cRng As Range, Rng1 As Range:     Dim Khong As Boolean
 Dim MyAdd As String:                  Dim Rw As Long, jJ As Byte, Cot As Byte, TAM As Byte
 Set cRng = Selection:                 Set Rng1 = cRng.Cells(1, 1)
'Dòng lệnh phần đầu: Gán vùng đã chọn vô biến;
 Dòng sau: Gán ô đầu tiên chứa trong biến vô 1 biến đối tượng Range khác:'
 Rw = cRng.Row:                        Cot = cRng.Columns.Count
'Phần đầu: Lấy số dòng trong biến gán vô biến Rw;
 Phần sau: Số cột của vùng chứa trong biến này được gán vô biến Cot:' 
 Set Rng = Range(Cells(Rw, "A"), Cells(Rw, Cells(Rw, "iV").End(xlToLeft).Column))
'Đem các ô có dữ liệu của vùng đã chọn (cùng hàng) gán vô biến đối tượng có tên là Rng:'
Set Rng = Cells(Rw, "A").Resize(, Rng.Columns.Count + Cot)
' Mở rọng vùng đang gán trong biến Rng thêm một số cột = với số cột ta đã chọn từ đầu:'
' Để tránh sai sót khi tìm kiếm bên dưới'
 Rng.Interior.ColorIndex = 0    'Xóa hết màu nền trong vùng có trong biến Rng' 
 'Thực hiện phương thức tìm trong Rng các vùng có thể có trùng với vùng chọn:'
Set sRng = Rng.Find(Rng1.Value, Rng1, xlFormulas, xlWhole)
' 2 dòng kế tiếp: Nếu không tìm thấy thì đưa ra câu cảnh báo:'
 If sRng Is Nothing Then
   MsgBox "Khong Có Vùng Giong Vay Trong Hàng"
 ' Còn tìm thấy thì thực hiện các lệnh tiếp theo:'
Else
' Gán địa chỉ ô tìm thấy vô biến MyAdd' 'Chú ý: Đọc từ phải sang dễ hiểu dòng lệnh hơn' 
   MyAdd = sRng.Address
'Thiết lập vòng lặp xử lý cho các lần tìm thấy:'
 Do
'Thiết lập vòng lặp For . . .Next để duyệt tất các ô trong vùng chọn:'
      For Each Clls In cRng
'Điều kiện là: Nếu từng ô trong vùng chọn có dữ liệu trùng với dữ liệu của các ô mà ô đầu tiên l2 ô tìm thấy & tương ứng tiếp theo thì:'
         If Clls.Value <> sRng.Offset(, jJ).Value Then
' Biến Yes/No được thiết lập := True:'
            Khong = Not Khong
'3 dòng kế tiếp đó là: gán Jj=0 & thoát khỏi vòng lặp tức thì & kết thúc viếc xét điều kiện'
            jJ = 0
            Exit For
         End If
'2 dòng kế tiếp:Tăng trị trong biến Jj 1 đơn vị & lấy nó gán vô biến TAM đã khai báo:'
         jJ = jJ + 1
         TAM = jJ
      Next Clls    'Kết thúc vòng lặp For. . . '
    If TAM = Cot Then ' Điều kiện nếu trị trong TAM = trị trong Jj thì thực thi 2 lệnh tiếp:'
'Tô màu cho vùng tìm thấy'
        sRng.Resize(, Cot).Interior.ColorIndex = 35 + Rw Mod 6 
        jJ = 0    ' Gán trị cho biến dùng trong vòng lặp'
    End If
' Thực hiện phương thức tìm tiếp các ô thỏa điều kiện trong hàng:'
      Set sRng = Rng.FindNext(sRng)
'Thoát vòng lặp Do. . .Loop khi thỏa các điều kiện này:'
   Loop While sRng.Address <> MyAdd
 End If
End Sub

 

[binhnguyenthanh]

Em lại có thêm nhiều khó khăn.

1. xin hỏi các bác nếu bài toán là dữ liệu nhập thông thường thì như bác SA_DQ đã sử dụng phương thức find để tìm kiếm. Nhưng nếu những ô dữ liệu đó sử dụng công thức thì không tìm được nữa. Các bác giúp em với.
2. Khi em chuyển đoạn mã trên sang excel 2007 đã thiết lập security setting và chuyển file sang định dạng xlsm nhưng vẫn không chạy được. file xlsm có dấu chấm than trên biểu tượng. xin đc các bác trợ giúp. Thanks

 

[SA_DQ]

1. xin hỏi các bác nếu bài toán là dữ liệu nhập thông thường thì như bác SA_DQ đã sử dụng phương thức find để tìm kiếm. Nhưng nếu những ô dữ liệu đó sử dụng công thức thì không tìm được nữa. Các bác trợ giúp với. Thanks

Nếu là công thức thì có 2 trường hợp sẩy ra:

(1) Tìm dữ liệu chứa trong các công thức giống nhau;

(2) Tìm công thức giống nhau; (Có lẽ hiếm!)

Nếu là (1) chúng ta có thể chép toàn bộ dữ liệu đến dòng trống nào đó mà tìm thôi
Từ hướng này chúng ta cũng có thể giải quyết cho trường hợp (2), nếu chúng ta chép các công thức trong hàng đó đến hàng khác, mỗi ô hàng mới ta thêm trước 1 dấu nháy đơn (') tổ chảng là OK thôi!

Chờ tin bạn!

 

[binhnguyenthanh]

Nếu là (1) chúng ta có thể chép toàn bộ dữ liệu đến dòng trống nào đó mà tìm thôi
Từ hướng này chúng ta cũng có thể giải quyết cho trường hợp (2), nếu chúng ta chép các công thức trong hàng đó đến hàng khác, mỗi ô hàng mới ta thêm trước 1 dấu nháy đơn (') tổ chảng là OK thôi!

công thức ở mỗi ô là khác nhau. chỉ có giá trị trả ra là giống nhau thôi. ý tôi muốn hỏi có phương thức so sánh nào khác phương thức "Clls.Value <> sRng.Offset(, jJ).Value" để so sánh được giá trị trong ô mà không để ý đến công thức không. Mong các cao thủ giúp đỡ!

 

[SA_DQ]

Như đã nói ở trên, Copy Special => Paste Values đến dòng mới & tìm từ dòng mới; Tất nhiên bằng VBA; Hãy đơi đấy!

 

[binhnguyenthanh]

Thanks các bác!!!

Mãi không thấy ai trả lời nhưng em cũng tìm ra rồi. Không cần phải copy dữ liệu. trong câu lệnh của bác SA_DQ : Set sRng = Rng.Find(Rng1.Value, Rng1, xlFormulas, xlWhole)
thay bằng : Set sRng = Rng.Find(Rng1.Value, Rng1, xlValues, xlWhole)là OK.
Thanks các bác lắm!!!

 

[binhnguyenthanh]

Bác nào biết chuyển nút lệnh lên thanh công cụ không?

Bảng dữ liệu của em lớn quá nên đặt nút lệnh trên bảng tính rất bất tiện. Em muốn đưa lên thanh công cụ có được không? Bác nào giúp em với.

 

[SA_DQ]

http://www.giaiphapexcel.com/forum/showthread.php?t=15603

Bạn đến đó tham khảo thử xem, bài #4 nha!

 

[binhnguyenthanh]

Thanks bác HYEN17 nhiều!

Theo hướng dẫn em làm được rồi! Các bác lại cho em hỏi làm cách nào để giới hạn số lần sử dụng macro. Vì công việc của em chỉ cho phép làm khoảng 50 lần mà cứ phải ngồi đếm thì mệt lắm. Thanks các bác nhé !!!

 

[ChanhTQ@]

Các bác cho em hỏi làm cách nào để giới hạn số lần sử dụng macro. Vì công việc của em chỉ cho phép làm khoảng 50 lần mà cứ phải ngồi đếm thì mệt lắm. Thanks các bác nhé !!!

Bạn trưng dụng 1 ô nào đó ở 2 góc phải của trang tính để ghi số lần vận hành macro;
Và việc còn lại là áp câu lệnh nếu trị tại ô đó vượt 50 thì buộc macro im re dùm cái; OK?!

 

[binhnguyenthanh]

Ý tưởng ấy thì em cũng đã nghĩ ra. Thanks bác!

Tuy vậy em muốn nó im mãi mãi luôn có được không? Tức là sau một số lần hữu hạn sử dụng thì tự disable cái macro ấy (do kết quả cần cố định và không được thay đổi). Hai là có thể đóng gói lại thành file cài đặt để lần sau sử dụng ở máy khác không phải copy hay gõ lại code nữa. Mong các bác lại chỉ giáo giúp. Thanks!