Lấy dữ liệu với 2 điều kiện bằng VBA

[nmhung49]

Em có bài này không biết làm thế nào mong các Anh Chị giúp, Bài này em đã kết hợp chút VBA với công thức nhưng file rất nặng nên không khả quan khi mà số liệu nhiều, Có thể lên đến hơn 15MB nên máy chạy không nổi. Mong anh chi giúp viết code dùm em với
Yêu cầu: Ứng với code sản phẩm và code khách hàng thì nó sẽ lấy dữ liệu bên sheet dulieu dán vào cột W, A tương ứng với khách hàng có lấy sản, Ví dụ với code khách hang 0021033470 thì nếu khách hàng đó có lấy những sản phẩm với điều kiện từ ô D1 đến AE1. Thì sẽ lấy dữ liệu của sản phẩm đó bên sheet dulieu paste vào cột D4, E4 …. Tương ứng với điều kiện trên. Cứ như vậy tiếp theo với những code kia. Em dùng công thức sumproduct thì ok mà file nó rất nặng. Mong A/C các bạn giúp đỡ. Em nghĩ đây là bài toán khó khi dùng VBA. Yêu cầu em có để đầy đủ trong file . Thanks

 

[ThuNghi]

Em có bài này không biết làm thế nào mong các Anh Chị giúp, Bài này em đã kết hợp chút VBA với công thức nhưng file rất nặng nên không khả quan khi mà số liệu nhiều, Có thể lên đến hơn 15MB nên máy chạy không nổi. Mong anh chi giúp viết code dùm em với
Yêu cầu: Ứng với code sản phẩm và code khách hàng thì nó sẽ lấy dữ liệu bên sheet dulieu dán vào cột W, A tương ứng với khách hàng có lấy sản, Ví dụ với code khách hang 0021033470 thì nếu khách hàng đó có lấy những sản phẩm với điều kiện từ ô D1 đến AE1. Thì sẽ lấy dữ liệu của sản phẩm đó bên sheet dulieu paste vào cột D4, E4 …. Tương ứng với điều kiện trên. Cứ như vậy tiếp theo với những code kia. Em dùng công thức sumproduct thì ok mà file nó rất nặng. Mong A/C các bạn giúp đỡ. Em nghĩ đây là bài toán khó khi dùng VBA. Yêu cầu em có để đầy đủ trong file . Thanks

File này giống file lấy định mức quá. Em nghiên cứu file sau, anh đã làm cho bạn, nếu OK anh sẽ sửa lại cho tương thích.

 

[ThuNghi]

Sửa code phù hợp với file của em.
1/ Chưa test phần nếu lấy mahh mà không có. Chưa thêm code countif để đếm
2/ Chưa thêm phần định dạng merge.
3/ Do maHH là text có số 0 đầu nên chưa test hết.
Em xem có gì anh sửa tiếp cho.
Vận dụng các bài về Dic của NDU đó.

Option Explicit
Sub TinhDM()
    Dim TG As Double
    Dim i As Long, endR As Long, j As Long, s As Long, t As Long, k As Long, m As Long
    Dim Arr01(), Arr02(), ArrKQ(1 To 65536, 1 To 100), Arr03(1 To 3, 1 To 1000)
    Dim MyDic1 As Object, MyDic2 As Object, MyDic3 As Object
    Dim tmp, iCol As Long, xCol As Long
'TG = Timer
With Sheets("KHSX")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr01 = .Range("A4:C" & endR).Value
End With
With Sheets("DinhMuc")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr02 = .Range("A2:E" & endR).Value
End With
t = 0
Set MyDic1 = CreateObject("scripting.dictionary")
Set MyDic2 = CreateObject("scripting.dictionary")
For s = 1 To UBound(Arr01)
  For i = 1 To UBound(Arr02)
    If Trim(Arr02(i, 1)) = Trim(Arr01(s, 1)) Then
      ArrKQ(s, 1) = "'" & CStr(Arr01(s, 1))
      'nho them dieu kien dem solan
      If Not MyDic1.Exists(Arr02(i, 1)) Then
        MyDic1.Add Arr02(i, 1), s
      End If
      tmp = Trim(Arr02(i, 2) & Arr02(i, 3))
      If Not MyDic2.Exists(tmp) Then
        t = t + 1
        MyDic2.Add tmp, t
        iCol = (MyDic2.Item(tmp) + 1) * 2
        Arr03(1, iCol - 3) = Arr02(i, 2) 'Code Pro
        Arr03(2, iCol - 3) = Arr02(i, 3) 'Name Pro
        Arr03(3, iCol - 3) = "W" 'Name Pro
        Arr03(3, iCol - 2) = "A" 'Name Pro
      End If
      xCol = (MyDic2.Item(tmp) + 1) * 2
      ArrKQ(s, xCol) = Arr02(i, 4)
      ArrKQ(s, xCol + 1) = Arr02(i, 5)
      ArrKQ(s, 2) = ArrKQ(s, 2) + Arr02(i, 4)
      ArrKQ(s, 3) = ArrKQ(s, 3) + Arr02(i, 5)
    End If
  Next i
Next s
With Sheets("KHSX")
  .Range("A4:IV100").ClearContents
  .Range("D2:IV1000").ClearContents
  .[A4].Resize(s, t * 2 + 3).Value = ArrKQ
  .[D1].Resize(3, t * 2).Value = Arr03

End With

Set MyDic1 = Nothing: Set MyDic2 = Nothing
Erase Arr01, ArrKQ, Arr02, Arr03
'MsgBox Format(Timer - TG, "0.000000000") & " seconds"
End Sub

 

[nmhung49]

Sửa code phù hợp với file của em.
1/ Chưa test phần nếu lấy mahh mà không có. Chưa thêm code countif để đếm
Cái này mình sẽ thêm vào chỗ nào trong đoạn code vậy anh
2/ Chưa thêm phần định dạng merge.
cái này em test ok rôi
3/ Do maHH là text có số 0 đầu nên chưa test hết.
Ma HH luôn luon không có số 0 đầu tiên chỉ có mã khách hàng mới có số không
Em xem có gì anh sửa tiếp cho.
Vận dụng các bài về Dic của NDU đó.
Và bị lỗi chỗ đoạn code này anh ơi Khi mà em copy những code cus có sẵn paste xuống thị ok
Mà thêm code mới thì bị lỗi cho đoạn code này em đoạn code không hiểu nên không biết sửa đành bó tay nhờ anh coi lại dùm

Option Explicit
xCol = (MyDic2.Item(tmp) + 1) * 2
ArrKQ(s, xCol) = Arr02(i, 4)
ArrKQ(s, xCol + 1) = Arr02(i, 5)
ArrKQ(s, 2) = ArrKQ(s, 2) + Arr02(i, 4)
ArrKQ(s, 3) = ArrKQ(s, 3) + Arr02(i, 5)

Thật chất là file này em đang dùng để tính Chiết khấu Khách Hàng giống như định mức mà anh nói, nhưng mỗi code có những định mức khác nhau. Nếu mà làm được giống sheet báo cáo thì hay biết mấy. Trong file anh gửi có cái tuyệt cú mèo mà khỏi dùm sumif mà vẫn tính tổng được rất đã. Với lại nếu có thể giải thích cài đoạn Set MyDic1 = CreateObject("scripting.dictionary")
Set MyDic2 = CreateObject("scripting.dictionary")cho tụi em hiểu với nhen a
Thanks. Em có đọc trong help VBA mà không thấy ví dụ MyDic2 = CreateObject("scripting.dictionary") và em cũng đang nghiên cứu về phương pháp find.method trong bài này anh coi có khả thi dùng nó không vậy

 

[ChanhTQ@]

Thực thi chỉ đạo của trưởng Topic:

Option Explicit
Sub FindAll()
 Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range, Rg0 As Range
 Dim MyAdd As String
 Dim Col As Byte
 
 Set Sh = Worksheets("DinhMuc"):             Sheets("BaoCao").Select
 Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
 For Each Cls In Range([A2], [A65500].End(xlUp))
   If Cls.Value <> "" Then
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         Cls.Offset(, 3).Resize(, 200).ClearContents
         MyAdd = sRng.Address
         Set Rg0 = Range(Cells(Cls.Row - 3, "d"), Cells(Cls.Row - 3, "iV").End(xlToLeft))
         Do
            sRng.Offset(, 1).Interior.ColorIndex = 30 + Cls.Row
            Col = TimCot(Rg0, sRng.Offset(, 1).Value)
            If Col > 0 Then
               Cells(Cls.Row, Col).Resize(, 2).Value = sRng.Offset(, 2).Resize(, 2).Value
               sRng.Interior.ColorIndex = 38
            End If
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      Else
         Cls.Interior.ColorIndex = 38
      End If
   End If
 Next Cls
End Sub

[B]Function TimCot(Rg0 As Range, LookUpValue As String) As Byte[/B]
   Dim Cls As Range
 For Each Cls In Rg0
   If Cls.Value = LookUpValue Then
      TimCot = Rg0.Column:                         Exit Function
   End If
 Next Cls
[B]End Function[/B]

Có những cái cùng mã hàng nhưng khác tên hàng nên macro cũng như mình chưa biết xoay sở ra sao; Xin ý kiến chỉ đạo tiếp!

Chờ tin Sếp, khà, khà,. . . !

 

[nmhung49]

Hehe lính lát không hà anh ChanhTQ ơi, Cảm ơn anh đã giúp em, mà sao đoạn code có bị lỗi gì đó không như ý muốn của em, đọc mấy đoạn code hoa cả mắt cỡ tay mới tập tành học VBA nhưng em làm sao biết để sữa được em đang cố gắng nghiên cứu VBA để chỉ lại các anh chị trong công ty mong các anh chị cao thủ VBA giúp đỡ. Thanks em gửi lại yêu cầu anh ThuNghi, ChanhTQ và các anh chị xin xem giúp em.

 

[SA_DQ]

Đán bị mắng lắm đó nghe!

Sub FindAll()
 Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
 Dim Rg0 As Range, Clls As Range
 
 Dim MyAdd As String
 Dim Col As Byte
 
 Set Sh = Worksheets("DinhMuc"):             Sheets("BaoCao").Select
 Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp))
 For Each Cls In Range([A2], [A65530].End(xlUp))
   If Cls.Value <> "" Then
      Set Rg0 = Range(Cells(Cls.Row - 3, "d"), Cells(Cls.Row - 3, "iV").End(xlToLeft))
      Cls.Offset(, 3).Resize(, 200).ClearContents
      
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            sRng.Offset(, 1).Interior.ColorIndex = 30 + Cls.Row
            For Each Clls In Rg0
               If Clls.Value = sRng.Offset(, 1).Value And _
                  Clls.Offset(1).Value = Trim(sRng.Offset(, 2).Value) Then
                  
                  Cells(Cls.Row, Clls.Column).Resize(, 2).Value = sRng.Offset(, 3).Resize(, 2).Value
                  sRng.Interior.ColorIndex = 38
               End If
            
            Next Clls
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      Else
         Cls.Interior.ColorIndex = 38
      End If
   End If
 Next Cls 
End Sub

Sao fải dùng hàm TRIM() nó mới đúng bạn biết không?​

 

[nmhung49]

Sao fải dùng hàm TRIM() nó mới đúng bạn biết không?[/SIZE][/CENTER]

Quá tuyệt cú mèo luôn Bác SA_DQ ơi, Cảm ơn Bác, anh ChanhTQ, ThuNghi nhiều, em đang nghiên cứu về VBA mà em đâu thể giải thích nổi đâu Bác giải thích giúp em luôn nhen. Tối nay em sẽ mổ sẻ những đoạn code của Bác, anh ChanhTQ, ThuNghi để nghiên cứu mới được. Tặng Bác và 2 anh thùng Phú Lễ, mấy trái rượu dừa khi nào về quê em nhen hehe

 

[SA_DQ]

Bác giải thích code giúp em luôn nhen. hehe

Sub FindAll() 
 Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range 
 Dim Rg0 As Range, Clls As Range   
 Dim MyAdd As String :                    Dim Col As Byte 
  
1 Set Sh = Worksheets("DinhMuc"):             Sheets("BaoCao").Select 
 Set Rng = Sh.Range(Sh.[A1], Sh.[A65500].End(xlUp)) 
3 For Each Cls In Range([A2], [A65530].End(xlUp)) 
   If Cls.Value <> "" Then 
5      Set Rg0 = Range(Cells(Cls.Row - 3, "d"), Cells(Cls.Row - 3, "iV").End(xlToLeft)) 
      Cls.Offset(, 3).Resize(, 200).ClearContents 
       
7      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole) 
      If Not sRng Is Nothing Then 
9         MyAdd = sRng.Address 
         Do 
11            sRng.Offset(, 1).Interior.ColorIndex = 30 + Cls.Row 
            For Each Clls In Rg0 
13               If Clls.Value = sRng.Offset(, 1).Value And _ 
                  Clls.Offset(1).Value = Trim(sRng.Offset(, 2).Value) Then 
                   
15                    Cells(Cls.Row, Clls.Column).Resize(, 2).Value = sRng.Offset(, 3).Resize(, 2).Value 
                  sRng.Interior.ColorIndex = 38 
17               End If              
            Next Clls 
19            Set sRng = Rng.FindNext(sRng) 
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd 
21      Else 
         Cls.Interior.ColorIndex = 38 
23      End If 
   End If 
25 Next Cls  
End Sub

3 đòng lệnh trước dòng 1: Khai báo các biến cần thiết cho chương trình;
D1: Lấy 1 trang tính gán vô biến đối tượng Sh; Chọn/kích hoạt trang tính cần thiết;
D2: Lấy vùng mã khách hàng tại cột 'A' gán vô biến Rng đã khai báo;
D3: Thiết lập 1 vòng lặp từ ô [A2] cho đến ô cuối của cột này có dữ liệu;
(Vòng lặp này kết thúc tại dòng lệnh 25)
D4: (Vì trong vùng duyệt có nhiều ô trống), nên đễ macro làm có hiệu suất, ta chỉ lấy các ô có dữ liệu đem khảo sát mà thôi.
D5: (Với ô trên cột 'A' đang kích hoạt), ta lấy ô 'D' có số dòng bé hơn ô hiện hành 3 dòng làm chuẩn & từ đây lấy sang fải hết các ô có dữ liệu ta đem gán vô biến Rg0 đã khai báo;
D6: Xóa dữ liệu cũ tại dòng hiện hành, bắt đầu từ cột 'D' trãi dài sang fải 200 cột;
D7: Thực hiện việc tìm kiếm mã khách hàng tại trang tính Sh;
D8: Đ/K (điều kiện) nếu tìm thấy thì thực hiện các lệnh từ Đ cho tới dòng 23;
D9: Địa chỉ ô tìm thấy được gán cho biến kiểu chuỗi đã khai báo;
D10: Tạo vòng lặp Do cho đến d20 để xử lý dữ liệu tìm thấy;
D11: Tô màu nền tím nhạt cho ô bên fải liền kề với ô tìm thấy;
D12: Tạo vòng lặp duyệt qua hết các ô đang chứa trong biến Rg0; Vòng này kết thúc ở dòng lệnh D18.
D13: Đ/K nếu dữ liệu trong ô đang duyệt (của biến Rg0) trùng với mã SF (sản fẩm) & tên SF trùng với ô dưới liền kề với ô đang duyệt, thì:
D15: Lấy W & A tương ứng của ô tìm thấy ghi vào cột tương ứng của hàng hiện hành (Cls) đang khảo sát;
D16: Tô màu nền có chỉ số 38 (Tím nhạt) lên ô tìm thấy;
D17 & D18: Kết thúc Đ/K & kết thúc chuyện khảo sát trong biến Rg0;
D19: Tìm tiếp những mã khách hàng trùng lặp; (Lặp lại quá trình tìm cho đến cạn kiệt)
D20: Thoát khi vòng lặp Do bên trên (D10)
D21 & D22: Đ/K nếu không tìm thấy mã khách hàng thì tô màu cho ô đang kích hoạt (Tại cột 'A' trang tính)
Các dòng lệnh còn lại: Đã nêu bên trên (Khóa đuôi như cách nói của các quân nhân)

(Dịch giả giữ bản quyền & cấm fổ biến rọng rãi & trao đổi hay kinh doanh)
</span></span>

 

[nmhung49]

(Dịch giả giữ bản quyền & cấm fổ biến rọng rãi & trao đổi hay kinh doanh)
</span></span>

Dạ, một lần nữa cảm ơn Bác nhiều nhiều lắm, cảm ơn các anh chị trên diễn đàn. Em chỉ phổ biến trong công ty em thôi có gì em nghi bản quyền của Bác và giaiphapexcel.com thôi Bác yên tâm hen hehe. Thanks

 

[nmhung49]

[COLOR=#000000][COLOR=#0000bb][FONT=Courier New][SIZE=1]Sub FindAll[/SIZE][/FONT][/COLOR][FONT=Courier New][SIZE=1][COLOR=#007700]() [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Dim Sh [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Worksheet[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Rng [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Cls [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]sRng [/COLOR][COLOR=#007700]As [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Range [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Dim Rg0 [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Clls [/COLOR][COLOR=#007700]As [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Range   [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Dim MyAdd [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000bb]String [/COLOR][COLOR=#007700]:                    [/COLOR][COLOR=#0000bb]Dim Col [/COLOR][COLOR=#007700]As [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Byte, i as interger[/COLOR][/SIZE][/FONT]
 
[SIZE=1][FONT=Courier New][COLOR=#0000bb]1 Set Sh [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Worksheets[/COLOR][COLOR=#007700]([/COLOR][COLOR=#dd0000]"DinhMuc"[/COLOR][COLOR=#007700]):             [/COLOR][COLOR=#0000bb]Sheets[/COLOR][COLOR=#007700]([/COLOR][COLOR=#dd0000]"BaoCao"[/COLOR][COLOR=#007700]).[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Select [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Set Rng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Sh[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Sh[/COLOR][COLOR=#007700].[[/COLOR][COLOR=#0000bb]A1[/COLOR][COLOR=#007700]], [/COLOR][COLOR=#0000bb]Sh[/COLOR][COLOR=#007700].[[/COLOR][COLOR=#0000bb]A65500[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700])) [/COLOR][/SIZE][/FONT][/COLOR]
[COLOR=#000000][FONT=Courier New][SIZE=1][COLOR=#007700]i = 0[/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]3 [/COLOR][COLOR=#007700]For [/COLOR][COLOR=#0000bb]Each Cls In Range[/COLOR][COLOR=#007700]([[/COLOR][COLOR=#0000bb]A3[/COLOR][COLOR=#007700], [[/COLOR][COLOR=#0000bb]A65530[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700])) [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#007700] If [/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]<> [/COLOR][COLOR=#dd0000]"" [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Then [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]5      Set Rg0 [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Row [/COLOR][COLOR=#007700]- i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#dd0000]"d"[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Row [/COLOR][COLOR=#007700]- i[/COLOR][COLOR=#007700], [/COLOR][COLOR=#dd0000]"iV"[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlToLeft[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700])) [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]3[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Resize[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]200[/COLOR][COLOR=#007700]).[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]ClearContents [/COLOR][/SIZE][/FONT]
 
[SIZE=1][FONT=Courier New][COLOR=#0000bb]7      Set sRng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Find[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Value[/COLOR][COLOR=#007700], , [/COLOR][COLOR=#0000bb]xlFormulas[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]xlWhole[/COLOR][/FONT][/SIZE][COLOR=#007700][FONT=Courier New][SIZE=1]) [/SIZE][/FONT][/COLOR]
[SIZE=1][FONT=Courier New][COLOR=#007700]    If [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Not sRng Is Nothing Then [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]9         MyAdd [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]sRng[/COLOR][COLOR=#007700].[/COLOR][/FONT][/SIZE][COLOR=#0000bb][FONT=Courier New][SIZE=1]Address [/SIZE][/FONT][/COLOR]
[FONT=Courier New][SIZE=1][COLOR=#007700]Do [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]11            sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]1[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Interior[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]ColorIndex [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]30 [/COLOR][COLOR=#007700]+ [/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Row [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#007700]For [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Each Clls In Rg0 [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]13               [/COLOR][COLOR=#007700]If [/COLOR][COLOR=#0000bb]Clls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]1[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]And [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]_ [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]                Clls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]1[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Trim[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]2[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Value[/COLOR][COLOR=#007700]) [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Then [/COLOR][/SIZE][/FONT]
 
[SIZE=1][FONT=Courier New][COLOR=#0000bb]15                    Cells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Row[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Clls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Column[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Resize[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]2[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Value [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]3[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Resize[/COLOR][COLOR=#007700](, [/COLOR][COLOR=#0000bb]2[/COLOR][COLOR=#007700]).[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#0000bb]Value [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]                sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Interior[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]ColorIndex [/COLOR][COLOR=#007700]= [/COLOR][/FONT][/SIZE][COLOR=#0000bb][FONT=Courier New][SIZE=1]38 [/SIZE][/FONT][/COLOR]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]17               End [/COLOR][/FONT][/SIZE][COLOR=#007700][FONT=Courier New][SIZE=1]If              [/SIZE][/FONT][/COLOR]
[FONT=Courier New][SIZE=1][COLOR=#0000bb]Next Clls [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]19            Set sRng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]FindNext[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]sRng[/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700]) [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Loop [/COLOR][COLOR=#007700]While [/COLOR][COLOR=#0000bb]Not sRng Is Nothing [/COLOR][COLOR=#007700]And [/COLOR][COLOR=#0000bb]sRng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Address [/COLOR][COLOR=#007700]<> [/COLOR][/FONT][/SIZE][COLOR=#0000bb][FONT=Courier New][SIZE=1]MyAdd [/SIZE][/FONT][/COLOR]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]21      [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700]Else [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]Cls[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Interior[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]ColorIndex [/COLOR][COLOR=#007700]= [/COLOR][/FONT][/SIZE][COLOR=#0000bb][FONT=Courier New][SIZE=1]38 [/SIZE][/FONT][/COLOR]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]23      End [/COLOR][/FONT][/SIZE][FONT=Courier New][SIZE=1][COLOR=#007700]If [/COLOR][/SIZE][/FONT]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]End [/COLOR][/FONT][/SIZE][COLOR=#007700][FONT=Courier New][SIZE=1]If [/SIZE][/FONT][/COLOR][/COLOR]
[COLOR=#000000][COLOR=#007700][FONT=Courier New][SIZE=1] i = i+1[/SIZE][/FONT][/COLOR]
[COLOR=#0000bb][SIZE=1][FONT=Courier New]25 Next Cls  [/FONT][/SIZE][/COLOR]
[SIZE=1][FONT=Courier New][COLOR=#0000bb]End Sub  [/COLOR][/FONT][/SIZE]
[/COLOR]

Sau khi em test thì đoạn code bị vài lỗi sau
sRng.Offset(, 1).Interior.ColorIndex = 30 + Cls.Row
lỗi cls.row vì nó vượt qua 57 thì cls.row tới dòng 27 Vì vậy phải bổ cls.row mà em thích màu đọt chuối nên em sửa thành 35 ok?
Lỗi Set Rg0 = Range(Cells(Cls.Row - 3, "d"), Cells(Cls.Row - 3, "iV").End(xlToLeft))
Sửa Set Rg0 = Range(Cells(Cls.Row - i, "d"), Cells(Cls.Row - i, "iV").End(xlToLeft))
Đồng thời đoạn code này For Each Cls In Range([A2],[A65530].End(xlUp))
Sửa thành For Each Cls In Range([A3,[A65530].End(xlUp)
cls.row - 3: Thì nó chỉ đúng với code đầu tiên của điều kiện trên nó thôi. Vì vậy phải khai báo thêm biến i mới đúng không biết có phải không Bác SA. Mà cho em hỏi thêm mình muốn bỏ hàm sumif trong file đó dùng VBA luôn thì mình viết code đặt vào chỗ nào vậy. Thí dụ sum weight theo Weight, sum amount theo amount của từng code khách hàng. Mà nếu dữ liệu cỡ 3000 dòng em thấy mất khoảng 1 phút có thể bị treo máy không biết có cách nào cải thiện tốc độ không vậy Bác? Nếu có gì sai nhờ các Mod gom bài lại dùm. Thanks

 

[SA_DQ]

Ừa, Code đó chỉ đúng với file đó thôi;

(*) Nếu số dòng >56 thì ta dùng hàm MOD() để nó di biến động trong vòng kim cô mà thôi;

(*) Lỗi 2 như tiêu đề ghi;

(*) Câu lệnh nhằm lấy hết các dòng có số liệu trong cột 'A'; còn muốn thử nghiệm cụ thể dòng nào hay vài dòng nào thì ta có thể áp đặt tùy biến.

Hãy cho biết dữ liệu thực tế là bao nhiêu dòng để còn định liệu;
Nếu hơn ngàn dòng thỉ ta bỏ đi các fù fiếm tô màu đó đi. Nó hữu ích cho ta lúc đầu để kiểm kết quả thôi. Vận động viên chạy muốn nước rút thì fải giảm thiểu quần áo trên người, chớ không thể cứ thùng thình mà nước rút được.

Để ghi hàm SUMIF() từ macro thì bạn có thể dùng bộ thu thử sức xem sao.

Vài lời cùng bạn, những mong hữu ích ít nhiều với bạn.