Giúp code lọc theo nhiều mã hàng (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
minhtuan55

minhtuan55

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
23/3/16
Bài viết
705
Được thích
52
Chào cả nhà GPE !
Em cần 1 đoạn code lọc theo nhiều mã hàng, nếu trùng tên mã hàng thì cộng dồn SL lại .Cụ thể em có gửi File mọi người xem giúp em. Em xin chân thành cảm ơn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
minhtuan55 đã viết:
Chào cả nhà GPE !
Em cần 1 đoạn code lọc theo nhiều mã hàng, nếu trùng tên mã hàng thì cộng dồn SL lại .Cụ thể em có gửi File mọi người xem giúp em. Em xin chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
code chạy cả Lọc 1 và Lọc 2
Mã: 
Sub GPE()
Dim Darr(), Arr(), Dic As Object, Tmp As String, MH As Long, Var As Variant, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim Arr(1 To UBound(Darr), 1 To 3)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then  'Loc 1
    Dic.Item(MH) = Dic.Item(MH) + 1
    Dic.Add MH & "#" & Dic.Item(MH), Array(Darr(i, 2), Darr(i, 3), Darr(i, 4))


    Tmp = Darr(i, 2)      'Loc 2
    If Not Dic.exists(Tmp) Then
      k = k + 1
      Dic.Add Tmp, k
      Arr(k, 1) = Darr(i, 2): Arr(k, 3) = Darr(i, 4)
    End If
    Arr(Dic.Item(Tmp), 2) = Arr(Dic.Item(Tmp), 2) + Darr(i, 3)
  End If
Next i
Range("K5:S1000").ClearContents
r = 4
For i = 5 To 9  'Loc 1
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      Var = Dic.Item(MH & "#" & n)
      r = r + 1
      Cells(r, "K") = MH:       Cells(r, "P") = MH
      Cells(r, "L") = Var(0)
      Cells(r, "M") = Var(1):   Cells(r, "N") = Var(2)
    Next n
  End If
Next i
Range("Q5").Resize(k, 3) = Arr  'Loc 2
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Dạ em cảm ơn anh. Code anh quá chính xác. Anh ơi anh có thể tách ra làm 2 Sub được không. Vì em mới viết VBA nên em cần đọc để hiểu và sau đó em áp dụng vào file trên công ty của em, chứ nhìn vào code em chẳng biết thay địa chỉ chổ nào. mong anh giúp em chia thành 2 sub Sub loc1() và Sub loc2()
HieuCD đã viết:
code chạy cả Lọc 1 và Lọc 2
Mã: 
Sub GPE()
Dim Darr(), Arr(), Dic As Object, Tmp As String, MH As Long, Var As Variant, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim Arr(1 To UBound(Darr), 1 To 3)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then  'Loc 1
    Dic.Item(MH) = Dic.Item(MH) + 1
    Dic.Add MH & "#" & Dic.Item(MH), Array(Darr(i, 2), Darr(i, 3), Darr(i, 4))


    Tmp = Darr(i, 2)      'Loc 2
    If Not Dic.exists(Tmp) Then
      k = k + 1
      Dic.Add Tmp, k
      Arr(k, 1) = Darr(i, 2): Arr(k, 3) = Darr(i, 4)
    End If
    Arr(Dic.Item(Tmp), 2) = Arr(Dic.Item(Tmp), 2) + Darr(i, 3)
  End If
Next i
Range("K5:S1000").ClearContents
r = 4
For i = 5 To 9  'Loc 1
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      Var = Dic.Item(MH & "#" & n)
      r = r + 1
      Cells(r, "K") = MH:       Cells(r, "P") = MH
      Cells(r, "L") = Var(0)
      Cells(r, "M") = Var(1):   Cells(r, "N") = Var(2)
    Next n
  End If
Next i
Range("Q5").Resize(k, 3) = Arr  'Loc 2
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
minhtuan55 đã viết:
Dạ em cảm ơn anh. Code anh quá chính xác. Anh ơi anh có thể tách ra làm 2 Sub được không. Vì em mới viết VBA nên em cần đọc để hiểu và sau đó em áp dụng vào file trên công ty của em, chứ nhìn vào code em chẳng biết thay địa chỉ chổ nào. mong anh giúp em chia thành 2 sub Sub loc1() và Sub loc2()
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Loc1()
Dim Darr(), Arr(), Dic As Object, MH As Long, Var As Variant, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim Arr(1 To UBound(Darr), 1 To 4)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then
    Dic.Item(MH) = Dic.Item(MH) + 1
    Dic.Add MH & "#" & Dic.Item(MH), Array(Darr(i, 2), Darr(i, 3), Darr(i, 4))
  End If
Next i
Range("K5:N1000").ClearContents
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      Var = Dic.Item(MH & "#" & n)
      r = r + 1
      Arr(r, 1) = MH
      Arr(r, 2) = Var(0):  Arr(r, 3) = Var(1):  Arr(r, 4) = Var(2)
    Next n
  End If
Next i
Range("K5").Resize(r, 4) = Arr
Application.ScreenUpdating = True
End Sub


Sub Loc2()
Dim Darr(), Arr(), MHarr(), Dic As Object, Tmp As String, MH As Long, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim MHarr(1 To UBound(Darr), 1 To 1)
ReDim Arr(1 To UBound(Darr), 1 To 3)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then
    Dic.Item(MH) = Dic.Item(MH) + 1
    Tmp = Darr(i, 2)
    If Not Dic.exists(Tmp) Then
      k = k + 1
      Dic.Add Tmp, k
      Arr(k, 1) = Darr(i, 2): Arr(k, 3) = Darr(i, 4)
    End If
    Arr(Dic.Item(Tmp), 2) = Arr(Dic.Item(Tmp), 2) + Darr(i, 3)
  End If
Next i
Range("P5:S1000").ClearContents
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      r = r + 1
      MHarr(r, 1) = MH
    Next n
  End If
Next i
Range("P5").Resize(r, 1) = MHarr
Range("Q5").Resize(k, 3) = Arr
Application.ScreenUpdating = True
End Sub
 
Upvote 0
loi loc 2.jpgDạ em cảm ơn anh. Anh quá nhiệt tình quá hihi. Anh ơi Code lọc 2 nó bị sao mà sau khi lọc xong nó cứ dư ra 1 mã hàng nằm hàng Dưới cùng ak

HieuCD đã viết:
Mã: 
Sub Loc1()
Dim Darr(), Arr(), Dic As Object, MH As Long, Var As Variant, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim Arr(1 To UBound(Darr), 1 To 4)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then
    Dic.Item(MH) = Dic.Item(MH) + 1
    Dic.Add MH & "#" & Dic.Item(MH), Array(Darr(i, 2), Darr(i, 3), Darr(i, 4))
  End If
Next i
Range("K5:N1000").ClearContents
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      Var = Dic.Item(MH & "#" & n)
      r = r + 1
      Arr(r, 1) = MH
      Arr(r, 2) = Var(0):  Arr(r, 3) = Var(1):  Arr(r, 4) = Var(2)
    Next n
  End If
Next i
Range("K5").Resize(r, 4) = Arr
Application.ScreenUpdating = True
End Sub


Sub Loc2()
Dim Darr(), Arr(), MHarr(), Dic As Object, Tmp As String, MH As Long, i As Long, k As Long, n As Long, r As Long
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
If Range("A65500").End(xlUp).Row < 5 Then Exit Sub
Darr = Range("A5:D" & Range("A65500").End(xlUp).Row).Value
ReDim MHarr(1 To UBound(Darr), 1 To 1)
ReDim Arr(1 To UBound(Darr), 1 To 3)
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Not Dic.exists(MH) Then Dic.Add MH, 0
Next i
For i = 1 To UBound(Darr)
  MH = Darr(i, 1)
  If Dic.exists(MH) Then
    Dic.Item(MH) = Dic.Item(MH) + 1
    Tmp = Darr(i, 2)
    If Not Dic.exists(Tmp) Then
      k = k + 1
      Dic.Add Tmp, k
      Arr(k, 1) = Darr(i, 2): Arr(k, 3) = Darr(i, 4)
    End If
    Arr(Dic.Item(Tmp), 2) = Arr(Dic.Item(Tmp), 2) + Darr(i, 3)
  End If
Next i
Range("P5:S1000").ClearContents
For i = 5 To 9
  MH = Cells(i, 8).Value
  If MH <> 0 And Dic.Item(MH) > 0 Then
    For n = 1 To Dic.Item(MH)
      r = r + 1
      MHarr(r, 1) = MH
    Next n
  End If
Next i
Range("P5").Resize(r, 1) = MHarr
Range("Q5").Resize(k, 3) = Arr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Hi bạn,
Mình cũng làm đúng như dữ liệu bạn đưa ra, bạn kiểm tra thử xem có được không nhé.
Code Lan2 mình có gom thêm cái mã hàng cho bạn trong trường hợp cộng trùng.
Mình viết đơn giản theo những gì mình hiểu thôi bạn thích sửa thêm gì thì cứ sửa nhé.
**** Lần 1 :
Mã: 
Sub Lan1()Dim i As Long, j As Long, k As Long, ij As Long
Dim sArr(), dArr(), vungDK()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                k = k + 1
                For ij = 1 To 4
                    dArr(k, ij) = sArr(i, ij)
                Next
            End If
        Next
    End If
Next
If k Then
    [K5].Resize(k, 4) = dArr
End If
End Sub
*** Lần 2 :
Mã: 
Sub Lan2()
Dim i As Long, k As Long, j As Long, ij As Long
Dim Dic As Object, Dic2 As Object, dArr(), sArr(), vungDK()
Set Dic = CreateObject("Scripting.dictionary")
Set Dic2 = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                If Not Dic2.exists(sArr(i, 2)) Then
                    k = k + 1
                    Dic2(sArr(i, 2)) = k
                    For ij = 1 To 4
                        dArr(k, ij) = sArr(i, ij)
                    Next
                    Else
                    dArr(Dic2.Item(sArr(i, 2)), 3) = dArr(Dic2.Item(sArr(i, 2)), 3) + sArr(i, 3)
                    dArr(Dic2.Item(sArr(i, 2)), 1) = dArr(Dic2.Item(sArr(i, 2)), 1) & "," & sArr(i, 1)
                End If
            End If
        Next
    End If
Next
If k Then
    [P5].Resize(k, 4) = dArr
End If
End Sub

Trong file mình có assign macro đến 2 shape bạn vẽ nên mình không khai báo tên sheet, cứ để cháu nó chạy tự nhiên... ahihi
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
hoamattroicoi đã viết:
Hi bạn,
Mình cũng làm đúng như dữ liệu bạn đưa ra, bạn kiểm tra thử xem có được không nhé.
Code Lan2 mình có gom thêm cái mã hàng cho bạn trong trường hợp cộng trùng.
Mình viết đơn giản theo những gì mình hiểu thôi bạn thích sửa thêm gì thì cứ sửa nhé.
**** Lần 1 :
Mã: 
Sub Lan1()Dim i As Long, j As Long, k As Long, ij As Long
Dim sArr(), dArr(), vungDK()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                k = k + 1
                For ij = 1 To 4
                    dArr(k, ij) = sArr(i, ij)
                Next
            End If
        Next
    End If
Next
If k Then
    [K5].Resize(k, 4) = dArr
End If
End Sub
*** Lần 2 :
Mã: 
Sub Lan2()
Dim i As Long, k As Long, j As Long, ij As Long
Dim Dic As Object, Dic2 As Object, dArr(), sArr(), vungDK()
Set Dic = CreateObject("Scripting.dictionary")
Set Dic2 = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                If Not Dic2.exists(sArr(i, 2)) Then
                    k = k + 1
                    Dic2(sArr(i, 2)) = k
                    For ij = 1 To 4
                        dArr(k, ij) = sArr(i, ij)
                    Next
                    Else
                    dArr(Dic2.Item(sArr(i, 2)), 3) = dArr(Dic2.Item(sArr(i, 2)), 3) + sArr(i, 3)
                    dArr(Dic2.Item(sArr(i, 2)), 1) = dArr(Dic2.Item(sArr(i, 2)), 1) & "," & sArr(i, 1)
                End If
            End If
        Next
    End If
Next
If k Then
    [P5].Resize(k, 4) = dArr
End If
End Sub
Trong file mình có assign macro đến 2 shape bạn vẽ nên mình không khai báo tên sheet, cứ để cháu nó chạy tự nhiên... ahihi
Nhấp chuột vào đây để mở rộng...
hình như cả 2 code đều dùng dư Dic, code 1 chỉ liệt kê nên không cần dùng Dic, chỉ dùng khi muốn tăng tốc bằng cách giảm số lần phải duyệt các dòng của sArr,
còn code 2 chỉ cần so sánh với vùng điều kiện và dùng Dic 2 là được
 
Upvote 0
Lần I chỉ vầy cũng được:
PHP: 
Option Explicit
Sub Loc2Lan()
 Dim Cls As Range, sArr(), Dict As Object
 Dim J As Long, Rws As Long, W As Long, Col As Byte
 
 Rws = [b4].CurrentRegion.Rows.Count
 sArr() = [A5].Resize(Rws, 4).Value
 ReDim Arr(1 To Rws, 1 To 4)
 [K5].CurrentRegion.Offset(2).ClearContents
 For Each Cls In Range([h5], [h5].End(xlDown))
    For J = 1 To UBound(Arr())
        If Not IsEmpty(sArr(J, 1)) And sArr(J, 1) = Cls.Value Then
            W = W + 1
            For Col = 1 To 4
                Arr(W, Col) = sArr(J, Col)
            Next Col
        End If
    Next J
 Next Cls
 If W Then
    [K5].Resize(W, 4).Value = Arr()
 End If
 W = 0                  ' Loc Làn Hai'

' . . . . . '
 
Upvote 0
Thank a. em thấy Code của anh ngắn gọn dễ thay đổi địa chỉ để em tùy biến theo nhu cầu của em. Cảm ơn anh nhiều lắm


hoamattroicoi đã viết:
Hi bạn,
Mình cũng làm đúng như dữ liệu bạn đưa ra, bạn kiểm tra thử xem có được không nhé.
Code Lan2 mình có gom thêm cái mã hàng cho bạn trong trường hợp cộng trùng.
Mình viết đơn giản theo những gì mình hiểu thôi bạn thích sửa thêm gì thì cứ sửa nhé.
**** Lần 1 :
Mã: 
Sub Lan1()Dim i As Long, j As Long, k As Long, ij As Long
Dim sArr(), dArr(), vungDK()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                k = k + 1
                For ij = 1 To 4
                    dArr(k, ij) = sArr(i, ij)
                Next
            End If
        Next
    End If
Next
If k Then
    [K5].Resize(k, 4) = dArr
End If
End Sub
*** Lần 2 :
Mã: 
Sub Lan2()
Dim i As Long, k As Long, j As Long, ij As Long
Dim Dic As Object, Dic2 As Object, dArr(), sArr(), vungDK()
Set Dic = CreateObject("Scripting.dictionary")
Set Dic2 = CreateObject("Scripting.dictionary")
vungDK = Range("H5:H9").Value
sArr = Range("A5:D35").Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For j = 1 To UBound(vungDK)
    If Not Dic.exists(vungDK(j, 1)) Then
        Dic(vungDK(j, 1)) = 0
        For i = 1 To UBound(sArr)
            If sArr(i, 1) = vungDK(j, 1) Then
                If Not Dic2.exists(sArr(i, 2)) Then
                    k = k + 1
                    Dic2(sArr(i, 2)) = k
                    For ij = 1 To 4
                        dArr(k, ij) = sArr(i, ij)
                    Next
                    Else
                    dArr(Dic2.Item(sArr(i, 2)), 3) = dArr(Dic2.Item(sArr(i, 2)), 3) + sArr(i, 3)
                    dArr(Dic2.Item(sArr(i, 2)), 1) = dArr(Dic2.Item(sArr(i, 2)), 1) & "," & sArr(i, 1)
                End If
            End If
        Next
    End If
Next
If k Then
    [P5].Resize(k, 4) = dArr
End If
End Sub

Trong file mình có assign macro đến 2 shape bạn vẽ nên mình không khai báo tên sheet, cứ để cháu nó chạy tự nhiên... ahihi
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Em cũng cần giúp tương tự nhưng ko bít thêm ntn ạ!
Em có ghi yêu cầu trong file đính kèm!
 

File đính kèm

Upvote 0
hitoko đã viết:
Em cũng cần giúp tương tự nhưng ko bít thêm ntn ạ!
Em có ghi yêu cầu trong file đính kèm!
Nhấp chuột vào đây để mở rộng...

Tên hàng B11 không giống B5 và B8, Bạn chú ý, khác 1 dấu cách cũng là 1 tên hàng khác nhau đấy.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Tem As String
sArr = Range("A5", Range("A5").End(xlDown)).Resize(, 3).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        Tem = sArr(I, 2) & "#" & sArr(I, 3)
        If Not .Exists(Tem) Then
            K = K + 1: .Add Tem, K
            dArr(K, 1) = sArr(I, 2): dArr(K, 2) = sArr(I, 3): dArr(K, 3) = sArr(I, 1)
        Else
            dArr(.Item(Tem), 3) = dArr(.Item(Tem), 3) + sArr(I, 1)
        End If
    Next I
End With
Range("E5:G1000").ClearContents
Range("E5:G5").Resize(K) = dArr
End Sub
 
Upvote 0
HieuCD đã viết:
- hình như cả 2 code đều dùng dư Dic, code 1 chỉ liệt kê nên không cần dùng Dic
- chỉ dùng khi muốn tăng tốc bằng cách giảm số lần phải duyệt các dòng của sArr,
còn code 2 chỉ cần so sánh với vùng điều kiện và dùng Dic 2 là được
Nhấp chuột vào đây để mở rộng...
- Cháu xài DIC vì phòng trường hợp tác giả nhập trùng vào vùng điều kiện (cột H) - lúc ấy dữ liệu liệt kê ra sẽ bị lặp.
- Nếu muốn nhanh thì không nên lồng vòng lặp For j như cháu làm ở trên, phải tách hẳn For j để đưa vùng điều kiện vào Dic >>> For i sẽ kiểm tra nếu dữ liệu mã hàng tồn tại trong Dic thì liệt kê dữ liệu tương ứng.

Cháu làm biếng nên không có sửa lại, hihihi
 
Upvote 0
Ba Tê đã viết:
Tên hàng B11 không giống B5 và B8, Bạn chú ý, khác 1 dấu cách cũng là 1 tên hàng khác nhau đấy.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Tem As String
sArr = Range("A5", Range("A5").End(xlDown)).Resize(, 3).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 3)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        Tem = sArr(I, 2) & "#" & sArr(I, 3)
        If Not .Exists(Tem) Then
            K = K + 1: .Add Tem, K
            dArr(K, 1) = sArr(I, 2): dArr(K, 2) = sArr(I, 3): dArr(K, 3) = sArr(I, 1)
        Else
            dArr(.Item(Tem), 3) = dArr(.Item(Tem), 3) + sArr(I, 1)
        End If
    Next I
End With
Range("E5:G1000").ClearContents
Range("E5:G5").Resize(K) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
thanknhiunhiu....hỏi vội quá thành ra ... :D
 
Upvote 0
HieuCD đã viết:
hình như cả 2 code đều dùng dư Dic, code 1 chỉ liệt kê nên không cần dùng Dic, chỉ dùng khi muốn tăng tốc bằng cách giảm số lần phải duyệt các dòng của sArr,
còn code 2 chỉ cần so sánh với vùng điều kiện và dùng Dic 2 là được
Nhấp chuột vào đây để mở rộng...

chú HieuCD giỏi quá à }}}}} , cháu đọc qua mà chẳng có hiểu được . Đến khi nào cháu mới lãnh ngộ được kiến thức như chú HieuCD đây !$@!!!$@!!
 
Upvote 0
hoamattroicoi đã viết:
- Cháu xài DIC vì phòng trường hợp tác giả nhập trùng vào vùng điều kiện (cột H) - lúc ấy dữ liệu liệt kê ra sẽ bị lặp.
- Nếu muốn nhanh thì không nên lồng vòng lặp For j như cháu làm ở trên, phải tách hẳn For j để đưa vùng điều kiện vào Dic >>> For i sẽ kiểm tra nếu dữ liệu mã hàng tồn tại trong Dic thì liệt kê dữ liệu tương ứng.
Cháu làm biếng nên không có sửa lại, hihihi
Nhấp chuột vào đây để mở rộng...
bạn viết rất chuẩn, mình hơi ngờ ngợ, không nghĩ tới trường hợp nầy +-+-+-+
 
Upvote 0
doveandrose đã viết:
chú HieuCD giỏi quá à }}}}} , cháu đọc qua mà chẳng có hiểu được . Đến khi nào cháu mới lãnh ngộ được kiến thức như chú HieuCD đây !$@!!!$@!!
Nhấp chuột vào đây để mở rộng...
đâu dám múa rìu qua mắt thợ !$@!!!$@!!, chỉ hơi lấn cấn không hình dung hết nên hỏi thôi
mấy hôm trước dùng độc chiêu Range của bạn làm eke_rula lúng túng/-*+//-*+/
 
Upvote 0
Mã: 
[COLOR=#007700][FONT=monospace][I]Public [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Sub GPE[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]()
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Dim sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]R [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]String
sArr [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"A5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"A5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]xlDown[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Resize[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](, [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Value
R [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]UBound[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ReDim dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To R[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To 3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]With CreateObject[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"Scripting.Dictionary"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
    For [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To R
        Tem [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) & [/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"#" [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]& [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        If [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Not [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Exists[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Then
            K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]+ [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]: .[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Add Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K
            dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]): [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]): [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        Else
            [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](.[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Item[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](.[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Item[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) + [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]If
    [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Next I
End With
Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"E5:G1000"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ClearContents
Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"E5:G5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Resize[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr
End Sub  [/I][/FONT][/COLOR]

Tình hình là code chạy ok nhưng có một chi tiết phát sinh là khi có 1 dòng trống thì công thức chỉ chạy đến dòng trống thôi .... các dòng sau đó không tính nữa! ... Ai giúp em dc ko ạ!
Em gửi lại file ạ.!
 

File đính kèm

Upvote 0
hitoko đã viết:
Mã: 
[COLOR=#007700][FONT=monospace][I]Public [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Sub GPE[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]()
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Dim sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]R [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Long[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]As [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]String
sArr [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"A5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"A5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]xlDown[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Resize[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](, [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Value
R [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]UBound[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ReDim dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To R[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To 3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]With CreateObject[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"Scripting.Dictionary"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
    For [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1 To R
        Tem [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) & [/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"#" [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]& [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        If [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Not [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I].[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Exists[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Then
            K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]= [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]+ [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]: .[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Add Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K
            dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]): [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]2[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]): [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        Else
            [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](.[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Item[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I](.[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Item[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Tem[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]), [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]3[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) + [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]sArr[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]I[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I], [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]1[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I])
        [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]End [/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]If
    [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Next I
End With
Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"E5:G1000"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]ClearContents
Range[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#DD0000][FONT=monospace][I]"E5:G5"[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]).[/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]Resize[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]([/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]K[/I][/FONT][/COLOR][COLOR=#007700][FONT=monospace][I]) = [/I][/FONT][/COLOR][COLOR=#0000BB][FONT=monospace][I]dArr
End Sub  [/I][/FONT][/COLOR]

Tình hình là code chạy ok nhưng có một chi tiết phát sinh là khi có 1 dòng trống thì công thức chỉ chạy đến dòng trống thôi .... các dòng sau đó không tính nữa! ... Ai giúp em dc ko ạ!
Em gửi lại file ạ.!
Nhấp chuột vào đây để mở rộng...
thay dòng nay là được
sArr = Range("A5", Range("A50000").End(xlUp)).Resize(, 3).Value
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

B
Làm sao đổi đơn vị B, M này sang hàng đơn vị vậy mọi người? (1 người xem)
    • Cười
Trả lời
1
Đọc
24
ptm0412
ptm0412
N
Thử lập trình XLL add-in bằng C/C++
    • Thích
Trả lời
0
Đọc
32
nguyendang95
N
Tuấn Bụng Bự
tạo QRcode chuyển khoản ngân hàng (1 người xem)
Trả lời
5
Đọc
190
Tuấn Bụng Bự
Tuấn Bụng Bự
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel (1 người xem)
Trả lời
11
Đọc
11K
dungnguyenMNCK
D
M
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác. (3 người xem)
Trả lời
1
Đọc
36
BuiQuangThuan
B
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
7
Đọc
7K
ptm0412
ptm0412
SA_DQ
[Xin hỏi] Cách tính số tiền bình quân của tài khoản trong 1 tháng
Trả lời
7
Đọc
109
ptm0412
ptm0412
Quách Ngọc
Trả về kết quả ngày tháng hay khoảng trống (1 người xem)
Trả lời
3
Đọc
54
Quách Ngọc
Quách Ngọc
MaxanB
Cần hỗ trợ công thức Vlookup nhiều sheet theo điều kiên (1 người xem)
Trả lời
2
Đọc
69
MaxanB
MaxanB
N
Không chạy được file VBA
Trả lời
3
Đọc
136
nhjngj
N
N
Xin giúp e cách lọc dữ liệu bị trùng
Trả lời
1
Đọc
59
hoangtuaotrang_hp_vn
H
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
8
Đọc
226
Nguyễn Nal
N
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
13
Đọc
149
Duy Tùng 9x
Duy Tùng 9x
K
Hỏi lỗi không kéo được công thức (Ctrl+D)
Trả lời
7
Đọc
123
khoinguyen2024
K
C
Filter có điều kiện đang ở dạng Cột
Trả lời
3
Đọc
115
Chí Còn Phí
C
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
216
Đọc
159K
dungnguyenMNCK
D
Nguyễn Duy Tuân
Hướng dẫn lập trình với Google Sheets và Excel Online bằng Excel VBA và Add-in A-Tools v10
    • Thích
Trả lời
10
Đọc
578
Nguyễn Duy Tuân
Nguyễn Duy Tuân
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
2
Đọc
60
Duy Tùng 9x
Duy Tùng 9x
Vũ Thị Thuý Ly
Em xin nhờ các anh chị trên diễn đàn giúp đỡ viết hàm hoặc VBA tính tổng các giá trị theo điều kiện
Trả lời
3
Đọc
53
bebo021999
B
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
16
Đọc
269
DinhManh1307
DinhManh1307
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom