Ghép mã theo điều kiện

[thinhnx22]

Chào các bạn, mình cần ghép mã hàng theo điều kiện ngày tháng và số hóa đơn. Chi tiết mình mô tả trong file. Cảm ơn các bạn đã quan tâm và xem file.

 

[snow25]

Chào các bạn, mình cần ghép mã hàng theo điều kiện ngày tháng và số hóa đơn. Chi tiết mình mô tả trong file. Cảm ơn các bạn đã quan tâm và xem file.

Bạn thử 2 code này nhé.Xem cái nào hợp với bạn.

Sub kk()
    Dim arr, i As Long, lr As Long, dic As Object, dk As String, kq
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("bang2")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A4:C" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                a = a + 1
                dic.Add dk, a
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
             Else
                b = dic.Item(dk)
                kq(b, 3) = kq(b, 3) & "&" & arr(i, 3)
             End If
        Next i
   End With
   With Sheets("BANG1")
        .Range("A10:C10000").ClearContents
        If a Then .Range("A10:C10").Resize(a).Value = kq
   End With
End Sub

Sub kk1()
    Dim arr, i As Long, lr As Long, dic As Object, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("bang2")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A4:C" & lr).Value
         For i = 1 To UBound(arr)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, arr(i, 3)
             Else
              dic.Item(dk) = dic.Item(dk) & "&" & arr(i, 3)
             End If
        Next i
   End With
   With Sheets("BANG1")
        .Range("C10:C10000").ClearContents
        arr = .Range("A10:C13").Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1) & "#" & arr(i, 2)
            If dic.exists(dk) Then
               arr(i, 3) = dic.Item(dk)
            End If
       Next i
            .Range("A10:C13").Value = arr
   End With
End Sub

 

[thinhnx22]

Bạn thử 2 code này nhé.Xem cái nào hợp với bạn.

Sub kk()
    Dim arr, i As Long, lr As Long, dic As Object, dk As String, kq
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("bang2")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A4:C" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                a = a + 1
                dic.Add dk, a
                kq(a, 1) = arr(i, 1)
                kq(a, 2) = arr(i, 2)
                kq(a, 3) = arr(i, 3)
             Else
                b = dic.Item(dk)
                kq(b, 3) = kq(b, 3) & "&" & arr(i, 3)
             End If
        Next i
   End With
   With Sheets("BANG1")
        .Range("A10:C10000").ClearContents
        If a Then .Range("A10:C10").Resize(a).Value = kq
   End With
End Sub

Sub kk1()
    Dim arr, i As Long, lr As Long, dic As Object, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("bang2")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A4:C" & lr).Value
         For i = 1 To UBound(arr)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, arr(i, 3)
             Else
              dic.Item(dk) = dic.Item(dk) & "&" & arr(i, 3)
             End If
        Next i
   End With
   With Sheets("BANG1")
        .Range("C10:C10000").ClearContents
        arr = .Range("A10:C13").Value
        For i = 1 To UBound(arr)
            dk = arr(i, 1) & "#" & arr(i, 2)
            If dic.exists(dk) Then
               arr(i, 3) = dic.Item(dk)
            End If
       Next i
            .Range("A10:C13").Value = arr
   End With
End Sub

Cảm ơn bạn nhiều nhé, vẫn viết như dic bình thường, thay vì cộng dồn thì ghép nó vào, vậy mà mĩnh nghĩ chưa ra. Mình đang không ở máy những nhìn thấy ok roài. Cảm ơn bạn lần nữa.

 

[snow25]

Cảm ơn bạn nhiều nhé, vẫn viết như dic bình thường, thay vì cộng dồn thì ghép nó vào, vậy mà mĩnh nghĩ chưa ra. Mình đang không ở máy những nhìn thấy ok roài. Cảm ơn bạn lần nữa.

Bạn muốn viết theo kiểu nào.?????

 

[thinhnx22]

Bạn muốn viết theo kiểu nào.?????

Code 1 bạn nhé.