Giúp mình giải pháp lọc dữ liệu với (2 người xem)

[luongkiengxuong]

mình test thử rồi chạy khoản 2 phút , cảm ơn bạn nhiều nhiều nhé, chút bạn cuối tuần vui vẻ và an lành !

 

[PacificPR]

Ý mình là so sánh số liệu từ cột 3-84 của cùng 1 mã nếu dòng nào có sự khác biệt trong bất kỳ cột nào từ 3-84 thì tô màu ô mã dòng đó.

Cái này là tô nguyên hàng luôn nha bạn không tìm được ô khác biệt đâu nha

Sub Tomau()
    Dim sArr, i As Long, j As Long
    Dim arr(), n As Long, Rng As Range
    Dim dic As Object, Tem1 As String, Tem2 As String, Tmp As String
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("Thang1")
        .Range("A1", .Range("A" & Rows.Count).End(3)).EntireRow.Interior.ColorIndex = 0
        sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 84).Value
        For i = 6 To UBound(sArr)
            Tmp = sArr(i, 1): n = 0
            If Not dic.Exists(Tmp) Then
                k = k + 1
                dic.Add Tmp, ""
                For j = 3 To UBound(sArr, 2)
                    n = n + 1
                    ReDim Preserve arr(1 To n)
                    arr(n) = sArr(i, j)
                Next j
                Tem1 = Join(arr, ";")
            Else
                For j = 3 To UBound(sArr, 2)
                    n = n + 1
                    ReDim Preserve arr(1 To n)
                    arr(n) = sArr(i, j)
                Next j
                Tem2 = Join(arr, ";")
                If Tem1 <> Tem2 Then
                    If Rng Is Nothing Then
                        Set Rng = .Range("A" & i).EntireRow
                    Else
                        Set Rng = Union(Rng, .Range("A" & i).EntireRow)
                    End If
                End If
            End If
        Next i
        Rng.Interior.ColorIndex = 6
    End With
End Sub

 

[luongkiengxuong]

Quá tuyệt vời bạn ơi chỉ cần vậy hôi để mình thấy được có sự thay đổ giá trị để mình giải trình, một lần nữa cảm ơn bạn rất nhiều !

 

[PacificPR]

Quá tuyệt vời bạn ơi chỉ cần vậy hôi để mình thấy được có sự thay đổ giá trị để mình giải trình, một lần nữa cảm ơn bạn rất nhiều !

Cái này chậm gấp 3 lần cái trước. Nhưng tô màu đúng ô

Sub Tomau1()
    Dim sArr, i As Long, j As Long
    Dim Rng As Range, Rng1 As Range
    Dim dic As Object, Tmp As String
    Dim Tmr As Double
    Tmr = Timer()
     Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("Thang1")
        .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 84).Interior.ColorIndex = xlNone
        sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 84).Value
        For i = 6 To UBound(sArr)
            Tmp = sArr(i, 1)
            If Not dic.Exists(Tmp) Then
                k = k + 1
                dic.Add Tmp, ""
                Set Rng1 = .Range(Cells(i, 3), .Cells(i, UBound(sArr, 2)))
            Else
                For j = 3 To UBound(sArr, 2)
                    If sArr(i, j) <> Rng1(1, j - 2) Then
                        If Rng Is Nothing Then
                            Set Rng = Union(.Cells(i, 1), .Cells(i, j))
                        Else
                            Set Rng = Union(Rng, .Cells(i, 1), .Cells(i, j))
                        End If
                    End If
                Next j
            End If
        Next i
        Rng.Interior.ColorIndex = 6
    End With
     Application.ScreenUpdating = True
    MsgBox Timer() - Tmr
End Sub

P/s: Cái này đang theo kiểu "Tên nào đẻ trước thì làm anh" chứ không chơi kiểu "Tên nào bỏ bú trước làm anh" đâu nha

 

[dothao3009]

Chào các anh chị, anh chi cho hỏi, tôi có 1 file, làm thế nào hoặc code để tìm được các dòng sai nhanh nhất?
Ví dụ: theo file gửi kèm tại dòng A25 và A26 giá trị đang bị sai. đúng nguyên tắc tài sản thứ n thì tương ứng là 20n và 30n

 

[phulien1902]

Chào các anh chị, anh chi cho hỏi, tôi có 1 file, làm thế nào hoặc code để tìm được các dòng sai nhanh nhất?
Ví dụ: theo file gửi kèm tại dòng A25 và A26 giá trị đang bị sai. đúng nguyên tắc tài sản thứ n thì tương ứng là 20n và 30n

Tôi dùng cách tô màu chỗ sai:

Sub abc()
    Dim i, LR
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = 7 To LR
           If Cells(i, 1).Value Like "*" & "Tai san thu" & "*" Then
                If Right(Cells(i, 1), 2) <> Right(Cells(i + 1, 1), 2) Then
                If Right(Cells(i, 1), 2) <> Right(Cells(i + 2, 1), 2) Then
                        Cells(i + 1, 1).Interior.ColorIndex = 6: Cells(i + 1, 2) = "False"
                        Cells(i + 2, 1).Interior.ColorIndex = 6: Cells(i + 2, 2) = "False"
                    End If
                End If
                End If
        Next
End Sub

 

[luongkiengxuong]

Cảm ơn bạn PacificPR bạn rất nhiệt tình và rất giỏi, bạn cho mình hỏi tí ! mình ở Tp HCM mình muốn học vba excel bạn có biết ở đâu có mở lớp dạy vậy.Cảm ơn bạn nhiều, chúc bạn cuối tuần vui vẻ

 

[PacificPR]

Cảm ơn bạn PacificPR bạn rất nhiệt tình và rất giỏi, bạn cho mình hỏi tí ! mình ở Tp HCM mình muốn học vba excel bạn có biết ở đâu có mở lớp dạy vậy.Cảm ơn bạn nhiều, chúc bạn cuối tuần vui vẻ

Vậy mình cách chỗ bạn khoảng 8h đi ô tô . Diễn đàn có mở lớp dạy đó. Bạn thử liên hệ xem

 

[luongkiengxuong]

OK cảm ơn bạn nhiều

 

[dothao3009]

OK. Cảm ơn bạn Phulien1902 rất nhiều

 

[luongkiengxuong]

chào bạn Phulien1902, chúc bạn đầu tuần vui vẻ và gặp nhiều may mắn, bạn giúp mình việc này được hok, mình đang rất rối về data, mình muốn tạo một user form trong file .xlsm hiện thị một list box gồm các tên sheets trong file có kèm check box của từng tên sheets khi mình check tùng tên sheets và ấn button combine thì sẽ copy tất cả dữ liệu những sheet được chọn vào sheet data. cảm ơn bạn nhé!

 

[luongkiengxuong]

bạn sửa giúp mình code này xíu nhé cảm ơn bạn
mình muốn tính tổng từ cột 9 đến 84 và cột cột bắt đầu là cột B chứ ko phải cột A
Sub Sum_abc()
Dim i&, j&, k&, ii%, Dic As Object, a, b, Tmp$
Sheet2.Range("A6").Resize(65000, 84).ClearContents
a = Range(Sheets("Thang1").[A5], Sheets("Thang1").[A65000].End(3)).Resize(, 84)
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
For i = 1 To UBound(a, 1)
Tmp = a(i, 1)
If Not .Exists(Tmp) Then
k = k + 1
.Add Tmp, k
For j = 1 To UBound(a, 2)
b(k, j) = a(i, j)
Next j
Else
For ii = 3 To 84
b(.Item(Tmp), ii) = b(.Item(Tmp), ii) + a(i, ii)
Next
End If
Next i
End With
With Sheets("Filter")
.Range("A6").Resize(k, UBound(a, 1)) = b
.Range("A6").Resize(, 84).Font.Bold = True
[A6].CurrentRegion.Borders.Value = 1
End With
End Sub