Tách và nhóm số hóa đơn theo từng mã code

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
huevantran

huevantran

Thành viên chính thức
Tham gia
27/4/22
Bài viết
55
Được thích
42
Em chào tất cả mọi người,

Hiện tại em có dữ liệu chạy ra từ phần mềm như bên dưới, em muốn tách số hóa đơn ra và nhóm lại theo từng mã Code, số hóa đơn sẽ đứng sau ký tự "#" và không cần lấy các số 0 ở đầu, các ô không phải hóa đơn thì bỏ qua. Nhờ các anh chị chỉ giúp em công thức hoặc mã code VBA để có thể thực hiện được thao tác này được không ạ.
Em cảm ơn !.


Kết quả mong muốn:
CodeDescriptionInvoice Number
ANAME 170338, 172, 164
A1C23TSS#00070338
A1C23TDN#00000172
A1C23TDN#00000164
BNAME 2183535, 184003
BDT-23E#0183535
BABCXYZ
BDT-23E#0184003
CNAME 320988, 20200876, 40894, 211859
CAA/13P#020988
C5C23GLL#20200876
CAA/19P#40894
C5K23GKU#211859
CABCCDEF
 

File đính kèm

  • GPE - Van.xlsx
    10.1 KB · Đọc: 23
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn thử code này xem được không?

Mã: 
Sub aaaa()
Dim i, j, lr As Long

lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 4 To lr

    If Left(Trim(Range("B" & i)), 4) = "NAME" Then
        For j = i + 1 To lr
        If Left(Trim(Range("B" & j)), 4) = "NAME" Or j = lr Then
            If j = lr Then
                Range("C" & i).Offset(1, 0).FormulaR1C1 = "=IFERROR(IF(ISNUMBER(FIND(""#"",RC[-1],1)),VALUE(MID(RC[-1],FIND(""#"",RC[-1],1)+1,LEN(RC[-1])-FIND(""#"",RC[-1],1))),""""),"""")"
                Range(Range("C" & i).Offset(1, 0), Range("C" & j)).FillDown
                Range("C" & i) = WorksheetFunction.TextJoin(", ", True, Range(Range("C" & i).Offset(1, 0), Range("C" & j)))
                
            Else
                Range("C" & i).Offset(1, 0).FormulaR1C1 = "=IFERROR(IF(ISNUMBER(FIND(""#"",RC[-1],1)),VALUE(MID(RC[-1],FIND(""#"",RC[-1],1)+1,LEN(RC[-1])-FIND(""#"",RC[-1],1))),""""),"""")"
                Range(Range("C" & i).Offset(1, 0), Range("C" & j).Offset(-1, 0)).FillDown
                Range("C" & i) = WorksheetFunction.TextJoin(", ", True, Range(Range("C" & i).Offset(1, 0), Range("C" & j).Offset(-1, 0)))
              
            End If
        Exit For
        End If
        Next j
    End If
Next i

End Sub
 
Upvote 0
gavbanhan đã viết:
Bạn thử code này xem được không?

Mã: 
Sub aaaa()
Dim i, j, lr As Long

lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

For i = 4 To lr

    If Left(Trim(Range("B" & i)), 4) = "NAME" Then
        For j = i + 1 To lr
        If Left(Trim(Range("B" & j)), 4) = "NAME" Or j = lr Then
            If j = lr Then
                Range("C" & i).Offset(1, 0).FormulaR1C1 = "=IFERROR(IF(ISNUMBER(FIND(""#"",RC[-1],1)),VALUE(MID(RC[-1],FIND(""#"",RC[-1],1)+1,LEN(RC[-1])-FIND(""#"",RC[-1],1))),""""),"""")"
                Range(Range("C" & i).Offset(1, 0), Range("C" & j)).FillDown
                Range("C" & i) = WorksheetFunction.TextJoin(", ", True, Range(Range("C" & i).Offset(1, 0), Range("C" & j)))
               
            Else
                Range("C" & i).Offset(1, 0).FormulaR1C1 = "=IFERROR(IF(ISNUMBER(FIND(""#"",RC[-1],1)),VALUE(MID(RC[-1],FIND(""#"",RC[-1],1)+1,LEN(RC[-1])-FIND(""#"",RC[-1],1))),""""),"""")"
                Range(Range("C" & i).Offset(1, 0), Range("C" & j).Offset(-1, 0)).FillDown
                Range("C" & i) = WorksheetFunction.TextJoin(", ", True, Range(Range("C" & i).Offset(1, 0), Range("C" & j).Offset(-1, 0)))
             
            End If
        Exit For
        End If
        Next j
    End If
Next i

End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh đã giúp, dữ liệu Name 1, Name 2, Name 3 là tên các công ty, nên hiện tại với dữ liệu giả lập thì code cho kết quả đúng, tuy nhiên với dữ liệu gốc sẽ bị lỗi. Em mong muốn số invoice được ghi vào dòng đầu tiên xuất hiện của mã code đó, xin lỗi vì em không nói rõ trước.
 
Upvote 0
huevantran đã viết:
Cảm ơn anh đã giúp, dữ liệu Name 1, Name 2, Name 3 là tên các công ty, nên hiện tại với dữ liệu giả lập thì code cho kết quả đúng, tuy nhiên với dữ liệu gốc sẽ bị lỗi. Em mong muốn số invoice được ghi vào dòng đầu tiên xuất hiện của mã code đó, xin lỗi vì em không nói rõ trước.
Nhấp chuột vào đây để mở rộng...
Data của bạn có lớn không. Mã code có được sắp xếp theo thứ tự không?
 
Upvote 0
BuiQuangThuan đã viết:
Data của bạn có lớn không. Mã code có được sắp xếp theo thứ tự không?
Nhấp chuột vào đây để mở rộng...
Dạ đây là công việc lặp đi lặp lại hàng tuần nên dữ liệu của em không lớn, khoảng 500 dòng trở lại, dữ liệu có sắp xếp nhóm lại theo từng mã code. Mục đích em muốn lọc số hóa đơn ra là để ghi vào nội dung diễn giải để bên nhận chuyển khoản họ biết đang trả tiền cho hóa đơn nào.
 
Upvote 0
huevantran đã viết:
Dạ đây là công việc lặp đi lặp lại hàng tuần nên dữ liệu của em không lớn, khoảng 500 dòng trở lại, dữ liệu có sắp xếp nhóm lại theo từng mã code. Mục đích em muốn lọc số hóa đơn ra là để ghi vào nội dung diễn giải để bên nhận chuyển khoản họ biết đang trả tiền cho hóa đơn nào.
Nhấp chuột vào đây để mở rộng...
ký thự "#" chỉ có duy nhất trong mã hóa đơn đúng không bạn?
 
Upvote 0
Nếu sử dụng Excel 365, có thể tham khảo công thức sau:
Mã: 
=IF(COUNTIF($A$4:A4,A4)=1,MID(TEXTJOIN(", ",TRUE,UNIQUE(IF($A$4:$A$17=A4,VALUE(TEXTAFTER($B$4:$B$17,"#",,,,0)),""))),4,99),"")
 

File đính kèm

  • GPE - Van.xlsx
    11.5 KB · Đọc: 13
Upvote 0
gavbanhan đã viết:
ký thự "#" chỉ có duy nhất trong mã hóa đơn đúng không bạn?
Nhấp chuột vào đây để mở rộng...
Vâng đúng rồi anh.

leonguyenz đã viết:
Nếu sử dụng Excel 365, có thể tham khảo công thức sau:
Mã: 
=IF(COUNTIF($A$4:A4,A4)=1,MID(TEXTJOIN(", ",TRUE,UNIQUE(IF($A$4:$A$17=A4,VALUE(TEXTAFTER($B$4:$B$17,"#",,,,0)),""))),4,99),"")
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh, máy em hiện tại công ty đang cho cài bản Excel 2021 ạ.
 
Upvote 0
huevantran đã viết:
Dạ đây là công việc lặp đi lặp lại hàng tuần nên dữ liệu của em không lớn, khoảng 500 dòng trở lại, dữ liệu có sắp xếp nhóm lại theo từng mã code. Mục đích em muốn lọc số hóa đơn ra là để ghi vào nội dung diễn giải để bên nhận chuyển khoản họ biết đang trả tiền cho hóa đơn nào.
Nhấp chuột vào đây để mở rộng...
Thử chạy Code này:
Mã: 
Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("A4:B" & .Range("A" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            If InStr(1, sArr(i, 2), "#") > 0 Then
                Dic(sArr(i, 1)) = Dic(sArr(i, 1)) & ", " & CLng(Split(sArr(i, 2), "#")(1))
            End If
        Next
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Res(i, 1) = Mid(Dic.Item(sArr(i, 1)), 3, Len(Dic.Item(sArr(i, 1))) - 2)
                Dic.Remove (sArr(i, 1))
            End If
        Next
        .Range("C4").Resize(UBound(sArr), 1).Value = Res
    End With
    Set Dic = Nothing
End Sub
 
Upvote 0
huevantran đã viết:
Em chào tất cả mọi người,

Hiện tại em có dữ liệu chạy ra từ phần mềm như bên dưới, em muốn tách số hóa đơn ra và nhóm lại theo từng mã Code, số hóa đơn sẽ đứng sau ký tự "#" và không cần lấy các số 0 ở đầu, các ô không phải hóa đơn thì bỏ qua. Nhờ các anh chị chỉ giúp em công thức hoặc mã code VBA để có thể thực hiện được thao tác này được không ạ.
Em cảm ơn !.


Kết quả mong muốn:
CodeDescriptionInvoice Number
ANAME 170338, 172, 164
A1C23TSS#00070338
A1C23TDN#00000172
A1C23TDN#00000164
BNAME 2183535, 184003
BDT-23E#0183535
BABCXYZ
BDT-23E#0184003
CNAME 320988, 20200876, 40894, 211859
CAA/13P#020988
C5C23GLL#20200876
CAA/19P#40894
C5K23GKU#211859
CABCCDEF
Nhấp chuột vào đây để mở rộng...
Tham khảo thêm nha
Mã: 
Sub GPE()
    Dim Dic As Object, Key, Lr&, Arr(), Res(), i&, k&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            Key = Arr(i, 1)
            If Not Dic.exists(Key) Then
                Dic.Add (Key), Split(Arr(i, 2), "#")(1) * 1
            Else
                Dic.Item(Key) = Dic.Item(Key) & "," & Split(Arr(i, 2), "#")(1) * 1
            End If
        Next i
        For i = 1 To UBound(Arr)
            k = k + 1
            For Each Key In Dic.keys
                If Arr(i, 1) = Key Then
                        Res(k, 1) = Dic.Item(Key)
                        Dic.Remove Key
                End If
            Next Key
        Next i
        .Range("D4").Resize(k, 1).Value = Res
    End With
    MsgBox "Done"
    Set Dic = Nothing
End Sub
 
Upvote 0
BuiQuangThuan đã viết:
Thử chạy Code này:
Mã: 
Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("A4:B" & .Range("A" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = 1 To UBound(sArr)
            If InStr(1, sArr(i, 2), "#") > 0 Then
                Dic(sArr(i, 1)) = Dic(sArr(i, 1)) & ", " & CLng(Split(sArr(i, 2), "#")(1))
            End If
        Next
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Res(i, 1) = Mid(Dic.Item(sArr(i, 1)), 3, Len(Dic.Item(sArr(i, 1))) - 2)
                Dic.Remove (sArr(i, 1))
            End If
        Next
        .Range("C4").Resize(UBound(sArr), 1).Value = Res
    End With
    Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Thóc Sama đã viết:
Tham khảo thêm nha
Mã: 
Sub GPE()
    Dim Dic As Object, Key, Lr&, Arr(), Res(), i&, k&
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).Value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            Key = Arr(i, 1)
            If Not Dic.exists(Key) Then
                Dic.Add (Key), Split(Arr(i, 2), "#")(1) * 1
            Else
                Dic.Item(Key) = Dic.Item(Key) & "," & Split(Arr(i, 2), "#")(1) * 1
            End If
        Next i
        For i = 1 To UBound(Arr)
            k = k + 1
            For Each Key In Dic.keys
                If Arr(i, 1) = Key Then
                        Res(k, 1) = Dic.Item(Key)
                        Dic.Remove Key
                End If
            Next Key
        Next i
        .Range("D4").Resize(k, 1).Value = Res
    End With
    MsgBox "Done"
    Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Dữ liệu đã xếp theo nhóm nên không cần dic, thử viết chỉ cần dùng 1 vòng For /-*+/ /-*+/ /-*+/
 
Upvote 0
Dạ, các bác ơi, trường hợp muốn loại hóa đơn trùng thì sao ạ, như thế này

ANAME 170338, 172
A1C23TSS#00070338
A1C23TDN#00000172
A1C23TDN#00070338

bổ sung cho em giúp, vì hiện tại chưa xảy ra, nhưng biết đâu tháng sau sẽ xảy ra thì khi em quay lại các bác nghỉ lễ hết rồi ạ

HieuCD đã viết:
Dữ liệu đã xếp theo nhóm nên không cần dic, thử viết chỉ cần dùng 1 vòng For /-*+/ /-*+/ /-*+/
Nhấp chuột vào đây để mở rộng...
Dạ liên quan đến nội dung trên thì em đoán vẫn cần dic ạ, em không biết VBA nhưng em biết dic, em thích dic lắm ạ

Xin cảm ơn ạ
 
Upvote 0
HieuCD đã viết:
Dữ liệu đã xếp theo nhóm nên không cần dic, thử viết chỉ cần dùng 1 vòng For /-*+/ /-*+/ /-*+/
Nhấp chuột vào đây để mở rộng...
Em cũng thử coi sao, nhưng có vẻ không đường đường chính chính lắm.-0-0-0-
Mã: 
Sub GPE()
    Dim Lr&, Arr(), i&, a
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            a = Application.Match(Arr(i, 1), .Range("A:A"), False)
            If Arr(i, 1) = Arr(i - 1, 1) Then
                If .Cells(a, 4) <> "" Then
                    .Cells(a, 4) = .Cells(a, 4) & "," & Split(Arr(i, 2), "#")(1) * 1
                Else
                    .Cells(a, 4) = Split(Arr(i, 2), "#")(1) * 1
                End If
            End If
        Next i
    End With
    MsgBox "Done"
End Sub
 
Upvote 0
Thóc Sama đã viết:
Em cũng thử coi sao, nhưng có vẻ không đường đường chính chính lắm.-0-0-0-
Nhấp chuột vào đây để mở rộng...
Duyệt từ dưới lên, nếu có số hóa đơn thì nối vào phía trước chuỗi kết quả tạm và nếu Code khác Code dòng liền trước thì ghi kết quả đồng thời xóa chuỗi kết quả tạm.
Nếu thêm điều kiện bỏ trung thì kiểm tra số hóa đơn có trong chuỗi tạm chưa bằng hàm InStr.
 
Upvote 0
Thóc Sama đã viết:
Em cũng thử coi sao, nhưng có vẻ không đường đường chính chính lắm.-0-0-0-
Mã: 
Sub GPE()
    Dim Lr&, Arr(), i&, a
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            a = Application.Match(Arr(i, 1), .Range("A:A"), False)
            If Arr(i, 1) = Arr(i - 1, 1) Then
                If .Cells(a, 4) <> "" Then
                    .Cells(a, 4) = .Cells(a, 4) & "," & Split(Arr(i, 2), "#")(1) * 1
                Else
                    .Cells(a, 4) = Split(Arr(i, 2), "#")(1) * 1
                End If
            End If
        Next i
    End With
    MsgBox "Done"
End Sub
Nhấp chuột vào đây để mở rộng...
Thóc Sama đã viết:
Em cũng thử coi sao, nhưng có vẻ không đường đường chính chính lắm.-0-0-0-
Mã: 
Sub GPE()
    Dim Lr&, Arr(), i&, a
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            a = Application.Match(Arr(i, 1), .Range("A:A"), False)
            If Arr(i, 1) = Arr(i - 1, 1) Then
                If .Cells(a, 4) <> "" Then
                    .Cells(a, 4) = .Cells(a, 4) & "," & Split(Arr(i, 2), "#")(1) * 1
                Else
                    .Cells(a, 4) = Split(Arr(i, 2), "#")(1) * 1
                End If
            End If
        Next i
    End With
    MsgBox "Done"
End Sub
Nhấp chuột vào đây để mở rộng...
Code VBA nên hạn chế dùng hàm bảng tính vì thường làm chậm code, ngoài ra giúp bạn luyện code
Mảng Arr bạn nên lấy dư 1 dòng, xét diều kiện sẽ dể hơn
 
Upvote 0
HieuCD đã viết:
Mảng Arr bạn nên lấy dư 1 dòng, xét diều kiện sẽ dể hơn
Nhấp chuột vào đây để mở rộng...
Theo gợi ý của Thầy và Anh @huuthang_bd .Chắc là thế này. Mong thầy và anh chỉ thêm.
Mã: 
Sub ABC()
    Dim sArr(), Res(), i&, Tmp$, inV$
    With Sheets("Sheet1")
        sArr = .Range("A3:B" & .Range("A" & Rows.Count).End(3).Row + 1).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = UBound(sArr) - 1 To 1 Step -1
            Tmp = sArr(i, 1)
            If sArr(i + 1, 1) = Tmp Then
                If InStr(1, sArr(i + 1, 2), "#") > 0 Then
                    If Len(inV) Then inV = inV & " ," & CLng(Split(sArr(i + 1, 2), "#")(1)) Else inV = CLng(Split(sArr(i + 1, 2), "#")(1))
                End If
            Else
                Res(i, 1) = inV
                inV = Empty
            End If
        Next
        .Range("C4").Resize(UBound(sArr), 1).Value = Res
    End With
End Sub
 
Upvote 0
Thóc Sama đã viết:
Em cũng thử coi sao, nhưng có vẻ không đường đường chính chính lắm.-0-0-0-
Mã: 
Sub GPE()
    Dim Lr&, Arr(), i&, a
    On Error Resume Next
    With Sheets("Sheet1")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Arr = .Range("A4:B" & Lr).value
        ReDim Res(1 To UBound(Arr), 1 To 1)
        For i = 1 To UBound(Arr)
            a = Application.Match(Arr(i, 1), .Range("A:A"), False)
            If Arr(i, 1) = Arr(i - 1, 1) Then
                If .Cells(a, 4) <> "" Then
                    .Cells(a, 4) = .Cells(a, 4) & "," & Split(Arr(i, 2), "#")(1) * 1
                Else
                    .Cells(a, 4) = Split(Arr(i, 2), "#")(1) * 1
                End If
            End If
        Next i
    End With
    MsgBox "Done"
End Sub
Nhấp chuột vào đây để mở rộng...
Em đã thử mã code này với dữ liệu thật, với trường hợp có nhiều số hóa đơn thì kết quả chạy bị lỗi, tuy nhiên nếu em định dạng cột chứa kết quả là dạng Text thì khi chạy code lại sẽ ra kết quả đúng. Cảm ơn anh.
Phuocam đã viết:
Nếu không có hàm TEXTAFTER(), thử công thức này:
Mã: 
=IF(COUNTIF($A$4:A4,A4)=1,TEXTJOIN(", ",1,IF(($A$4:$A$17=A4)*ISNUMBER(SEARCH("#",$B$4:$B$17)),
--RIGHT(SUBSTITUTE($B$4:$B$17,"#",REPT(" ",100)),100),"")),"")
Nhấp chuột vào đây để mở rộng...
Công thức trả kết quả chính xác rồi ạ. Cảm ơn anh.
BuiQuangThuan đã viết:
Theo gợi ý của Thầy và Anh @huuthang_bd .Chắc là thế này. Mong thầy và anh chỉ thêm.
Mã: 
Sub ABC()
    Dim sArr(), Res(), i&, Tmp$, inV$
    With Sheets("Sheet1")
        sArr = .Range("A3:B" & .Range("A" & Rows.Count).End(3).Row + 1).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = UBound(sArr) - 1 To 1 Step -1
            Tmp = sArr(i, 1)
            If sArr(i + 1, 1) = Tmp Then
                If InStr(1, sArr(i + 1, 2), "#") > 0 Then
                    If Len(inV) Then inV = inV & " ," & CLng(Split(sArr(i + 1, 2), "#")(1)) Else inV = CLng(Split(sArr(i + 1, 2), "#")(1))
                End If
            Else
                Res(i, 1) = inV
                inV = Empty
            End If
        Next
        .Range("C4").Resize(UBound(sArr), 1).Value = Res
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Mã code trả kết quả chính xác rồi ạ. Cảm ơn anh.

Việc xử lý số hóa đơn trùng trong trường hợp này không cần thiết, vì số hóa đơn giống nhau là chuyện bình thường ạ. Đa số 1 lệnh thanh toán là thanh toán cho hóa đơn thuộc về 1 công ty đó, nên hóa đơn trùng nhau sẽ ít gặp. Chỉ có 1 số ít công ty họ làm dịch vụ trọn gói rồi yêu cầu công ty thanh toán lại những khoản phát sinh đó, lúc này số hóa đơn trùng nhau có thể có nhưng cũng sẽ không nhiều, và số hóa đơn trùng nhau là chấp nhận được.
Cảm ơn tất cả mọi người đã quan tâm, em sẽ dành thời gian để nghiên cứu code và công thức của các anh cho.
Chúc mọi người cuối tuần vui vẻ và an lành ạ.
 
Upvote 0
BuiQuangThuan đã viết:
Theo gợi ý của Thầy và Anh @huuthang_bd .Chắc là thế này. Mong thầy và anh chỉ thêm.
Mã: 
Sub ABC()
    Dim sArr(), Res(), i&, Tmp$, inV$
    With Sheets("Sheet1")
        sArr = .Range("A3:B" & .Range("A" & Rows.Count).End(3).Row + 1).Value
        ReDim Res(1 To UBound(sArr), 1 To 1)
        For i = UBound(sArr) - 1 To 1 Step -1
            Tmp = sArr(i, 1)
            If sArr(i + 1, 1) = Tmp Then
                If InStr(1, sArr(i + 1, 2), "#") > 0 Then
                    If Len(inV) Then inV = inV & " ," & CLng(Split(sArr(i + 1, 2), "#")(1)) Else inV = CLng(Split(sArr(i + 1, 2), "#")(1))
                End If
            Else
                Res(i, 1) = inV
                inV = Empty
            End If
        Next
        .Range("C4").Resize(UBound(sArr), 1).Value = Res
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Do bạn nối hóa đơn vào phía sau nên các hóa đơn bị xếp ngược. Là tôi thì tôi sẽ làm vầy.
Rich (BB code): 
Sub ABCD()
    Dim sArr As Variant, Res As Variant, i As Long, Tmp As String, inV As String
    sArr = Sheet1.Range("A3:B" & Sheet1.Range("A" & &H100000).End(3).Row).Value
    ReDim Res(2 To UBound(sArr, 1), 1 To 1)
    For i = UBound(sArr, 1) To 2 Step -1
        inV = Split(sArr(i, 2) & "#", "#")(1)
        If IsNumeric(inV) Then
            Tmp = ", " & CStr(CLng(inV)) & Tmp
        End If
        If sArr(i, 1) <> sArr(i - 1, 1) Then
            Res(i, 1) = Mid(Tmp, 3)
            Tmp = ""
        End If
    Next
    Sheet1.Range("C4").Resize(UBound(Res, 1) - 1, 1).Value = Res
End Sub
 
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

O
  • Question
Tìm số thứ tự của sheet trong workbook có nhiều sheets
Trả lời
13
Đọc
3K
Hoàng Tuấn 868
H
H
  • Question
Xóa toàn bộ các dòng giống nhau ở 1 cột
    • Cười
Trả lời
13
Đọc
105
SA_DQ
SA_DQ
S
Hỏi cách nhập dữ liệu vào 1 ô trả kết quả ở 1 ô khác có công thức
Trả lời
9
Đọc
168
Hoàng Tuấn 868
H
pingping2288
Lỗi cứ lần mở lại file excel là font chữ và định dạng ô lại thay đổi
Trả lời
14
Đọc
136
Hoàng Tuấn 868
H
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
14
Đọc
243
vova2209
vova2209
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
164
Đọc
8K
chstbcaolanh
C
T
Đánh Số Thứ Tự Loại Bỏ Trùng
Trả lời
1
Đọc
41
bebo021999
B
H
Có thể mở file Excel mới sẽ Zoom mặc định 150% không?
Trả lời
4
Đọc
171
VetMini
V
Manhhung90
Liệt kê các ngày cộng dồn mong muốn vào 1 ô. Nhờ mọi người giúp mình ạ.
2 3 4
Trả lời
62
Đọc
755
VetMini
V
C
Hàm đánh số thứ tự như không đánh dữ liệu trùng
Trả lời
7
Đọc
8K
Trang Tuyet Ngoc Nhi
T
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
473
tranhungdao12a3
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
4
Đọc
472
PhanTuHuong
PhanTuHuong
tvcneo
  • Question
Nhờ Anh Chị Em giúp mình cách để tạo macro giống như trong file này
Trả lời
17
Đọc
233
huuthang_bd
huuthang_bd
T
Có phải lỗi Excel?
Trả lời
8
Đọc
9K
dinhthang8709
D
T
Công thức lấy dữ liệu
Trả lời
3
Đọc
126
HUONGHCKT
H
S
  • Question
Nhờ anh chị giúp em hàm ngẫu nhiên với tổng là 1 số
Trả lời
6
Đọc
153
SA_DQ
SA_DQ
L
Tự động nhảy số tham chiếu khi sang sheet mới
Trả lời
5
Đọc
5K
Romantic92
R
TieuLong2708
Danh sách lịch cắt người trực
Trả lời
0
Đọc
39
TieuLong2708
TieuLong2708
C
  • Question
Xin giúp đỡ Code kiểm tra và copy dữ liệu từ sheet 1 sang sheet 2
2
Trả lời
21
Đọc
630
conan1
C
H
  • Question
Mong giúp code chuyển file xls sang xlsx hàng loạt và không lỗi số liệu
Trả lời
16
Đọc
380
Hoàng Tuấn 868
H
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

Back
Top Bottom