Nhờ giúp đỡ về gộp chuỗi mã hàng

Liên hệ QC
Dữ liệu ít hay nhiều gì thì code trên cũng phải dựa vào điều kiện là dữ liệu đã được sắp xếp.
Thử thay đổi thứ tự dữ liệu trong file mẫu, chạy thì biết liền.
 
Đố các bạn nhậu của tui, với dữ liệu của bài #12 viết code với 1 vòng lặp ra kết quả
Nếu bạn nào viết được & nếu chủ nhật này tui bốc thăm mà trúng quà, tui sẽ....tặng quà lại cho bạn đó
Thân
 
Bạn thử cái sub này xem đúng không.
Mã:
Sub gopdulieu()
    Dim arr, i As Long, s As String, kq, dic As Object, ngay As String, b As Long, T, k As Integer, s1 As String, s2 As String
    Dim a As Long, ten As String, j As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
         arr = .Range("B5:C58").Value
         ReDim kq(1 To UBound(arr), 1 To 2)
         For i = 1 To UBound(arr)
             ngay = arr(i, 2)
             If Not dic.exists(ngay) Then
                dic.Add ngay, "#" & arr(i, 1)
                a = a + 1
                kq(a, 1) = ngay
             Else
                s = dic.Item(ngay)
                s = s & "#" & arr(i, 1)
                dic.Item(ngay) = s
             End If
       Next i
       For i = 1 To a
           s = dic.Item(kq(i, 1))
           T = Split(s, "#")
           b = UBound(T)
         
           For k = 1 To b
             s1 = T(k)
             If InStr(1, s, s1) Then
                ten = ten & ";" & s1
                j = 0
                Do
                   j = j + 1
                   s2 = Left(s1, Len(s1) - 4) & (Right(s1, 4) + j)
                   If InStr(1, s, s2) Then
                      s = Replace(s, s2, "")
                   Else
                      s2 = Left(s1, Len(s1) - 4) & (Right(s1, 4) + j - 1)
                      If s1 <> s2 Then ten = ten & "-" & s2
                      Exit Do
                   End If
                Loop
             End If
          Next k
           kq(i, 2) = Right(ten, Len(ten) - 1)
           ten = Empty
       Next i
       .Range("F14:G14").Resize(a).Value = kq
   End With
End Sub
Mình có vấn đề cần giúp đỡ, nếu một số mã hàng chưa xuất được mình muốn thống kê riêng vào mục hàng tồn (File đính kèm). nhờ bạn sửa code giúp
 

File đính kèm

  • Thống kê mã hàng xuất theo ngày.xlsm
    25.4 KB · Đọc: 3
Web KT
Back
Top Bottom