Giúp code lấy tên hàng và số lượng (1 người xem)

[congnguyen88]

Mình có 1 bảng tính hàng hóa, tên hàng và số lượng được nối lại bở dấu *, Anh em giúp mình cho mình 1 đoạn code để Tách tên hàng và số lượng
( Lưu ý : trong 1 ô của cột tên hàng gốc đã nối này chỉ có tối đa 50 tên hàng thôi )

* Kiểu nối tên hàng với số lượng như sau:

Tên hàng1_[số lượng1],_Tên hàng2_[số lượng2],…...Tên hàng50_[số lượng5],

Dấu _ là dấu cách đó

* Ví dụ :
Bưởi [1], đu đủ [1], nho [1],
Nghĩa là bưởi có số lượng là 1, đu đủ có số lượng là 1 , nho có số lượng là 1

* lý do làm :
Vì em phải thường xuyên cộng dồn số lượng theo tên mặt hàng, nên tách ra thì mới dùng hàm Sumif được, Mong anh em nhiệt tình giúp đở. Xin cảm ơn rất nhiều !

 

[hungpecc1]

Mình có 1 bảng tính hàng hóa, tên hàng và số lượng được nối lại bở dấu *, Anh em giúp mình cho mình 1 đoạn code để Tách tên hàng và số lượng
( Lưu ý : trong 1 ô của cột tên hàng gốc đã nối này chỉ có tối đa 50 tên hàng thôi )

* Kiểu nối tên hàng với số lượng như sau:

Tên hàng1_[số lượng1],_Tên hàng2_[số lượng2],…...Tên hàng50_[số lượng5],

Dấu _ là dấu cách đó

* Ví dụ :
Bưởi [1], đu đủ [1], nho [1],
Nghĩa là bưởi có số lượng là 1, đu đủ có số lượng là 1 , nho có số lượng là 1

* lý do làm :
Vì em phải thường xuyên cộng dồn số lượng theo tên mặt hàng, nên tách ra thì mới dùng hàm Sumif được, Mong anh em nhiệt tình giúp đở. Xin cảm ơn rất nhiều !

Đã mất công viết code , thì ta nên lồng luôn việc công dồn số lượng theo mặt hàng :
mình thử ví dụ code sau :

Sub GPE()
Dim dic As Object, objmatch As Object
Dim TmpArr, tmp, Item, ArrSource, ArrResult(1 To 50, 1 To 2), strResult$
Dim i&, j&, n&, TenHang$, Sluong&
    Set dic = CreateObject("scripting.dictionary")
    ArrSource = Range("A2", [A65536].End(3))
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = ",*(.+?)\[\s*(\d+)\s*\]"
        For i = 1 To UBound(ArrSource, 1)
            tmp = ArrSource(i, 1)
            If .test(tmp) Then
                Set objmatch = .Execute(tmp)
                For Each Item In objmatch
                    TenHang = Application.Trim(Item.submatches(0))
                    Sluong = Val(Item.submatches(1))
                    If Not dic.exists(TenHang) Then
                        j = j + 1
                        dic.Add TenHang, j
                        ArrResult(j, 1) = TenHang
                        ArrResult(j, 2) = Sluong
                    Else
                       n = dic.Item(TenHang)
                       ArrResult(n, 2) = Sluong + ArrResult(n, 2)
                    End If
                Next
            End If
        Next
    End With
    For i = 1 To j
        strResult = strResult & ArrResult(i, 1) & vbTab & ArrResult(i, 2) & vbLf
    Next
    MsgBox strResult: Range("B3").Resize(50, 2) = ArrResult
    Set dic = Nothing
End Sub

 

[congnguyen88]

Đã mất công viết code , thì ta nên lồng luôn việc công dồn số lượng theo mặt hàng :
mình thử ví dụ code sau :

Sub GPE()
Dim dic As Object, objmatch As Object
Dim TmpArr, tmp, Item, ArrSource, ArrResult(1 To 50, 1 To 2), strResult$
Dim i&, j&, n&, TenHang$, Sluong&
    Set dic = CreateObject("scripting.dictionary")
    ArrSource = Range("A2", [A65536].End(3))
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = ",*(.+?)\[\s*(\d+)\s*\]"
        For i = 1 To UBound(ArrSource, 1)
            tmp = ArrSource(i, 1)
            If .test(tmp) Then
                Set objmatch = .Execute(tmp)
                For Each Item In objmatch
                    TenHang = Application.Trim(Item.submatches(0))
                    Sluong = Val(Item.submatches(1))
                    If Not dic.exists(TenHang) Then
                        j = j + 1
                        dic.Add TenHang, j
                        ArrResult(j, 1) = TenHang
                        ArrResult(j, 2) = Sluong
                    Else
                       n = dic.Item(TenHang)
                       ArrResult(n, 2) = Sluong + ArrResult(n, 2)
                    End If
                Next
            End If
        Next
    End With
    For i = 1 To j
        strResult = strResult & ArrResult(i, 1) & vbTab & ArrResult(i, 2) & vbLf
    Next
    MsgBox strResult: Range("B3").Resize(50, 2) = ArrResult
    Set dic = Nothing
End Sub

Phải nói là quá tuyệt vời, Code quá hay, từ nay em không đến Chú Sumif nữa tạo tới 50 cột phụ mệt muốn chết luôn, Thank anh nhiều nha

Cảm ơn anh nhiều nhiều

 

[SA_DQ]

Nếu bạn vẫn muốn kết quả liệt kê lên bảng "ngang", thì xài hàm mảng này

 

[congnguyen88]

Ok thank anh, Code của anh cũng khá hay đấy

 

[ndu96081631]

Mình có 1 bảng tính hàng hóa, tên hàng và số lượng được nối lại bở dấu *, Anh em giúp mình cho mình 1 đoạn code để Tách tên hàng và số lượng
( Lưu ý : trong 1 ô của cột tên hàng gốc đã nối này chỉ có tối đa 50 tên hàng thôi )

* Kiểu nối tên hàng với số lượng như sau:

Tên hàng1_[số lượng1],_Tên hàng2_[số lượng2],…...Tên hàng50_[số lượng5],

Dấu _ là dấu cách đó

* Ví dụ :
Bưởi [1], đu đủ [1], nho [1],
Nghĩa là bưởi có số lượng là 1, đu đủ có số lượng là 1 , nho có số lượng là 1

* lý do làm :
Vì em phải thường xuyên cộng dồn số lượng theo tên mặt hàng, nên tách ra thì mới dùng hàm Sumif được, Mong anh em nhiệt tình giúp đở. Xin cảm ơn rất nhiều !

Bài này tôi làm bằng tay cũng ra
- Quét chọn vùng dữ liệu, bấm Ctrl + H ---> Khung Find what gõ dấu [ ---> khung Replace with gõ dấu * ---> bấm Replace All
- Tiếp tục bấm Ctrl + H ---> Khung Find what gõ dấu ] ---> khung Replace with gõ dấu * ---> bấm Replace All
- Tiếp tục bấm Ctrl + H ---> Khung Find what gõ dấu , ---> khung Replace with để trống ---> bấm Replace All
- Gọi công cụ Text to Columns ---> Chọn Delimited, bấm Next ---> Mục Other gõ dấu * --> Bấm Next rồi Finish
----------------------
Cũng có thể viết code dựa theo cách làm trên, bảo đảm ngắn gọn

 

[phuoclocvl]

Đã mất công viết code , thì ta nên lồng luôn việc công dồn số lượng theo mặt hàng :
mình thử ví dụ code sau :

Sub GPE()
Dim dic As Object, objmatch As Object
Dim TmpArr, tmp, Item, ArrSource, ArrResult(1 To 50, 1 To 2), strResult$
Dim i&, j&, n&, TenHang$, Sluong&
    Set dic = CreateObject("scripting.dictionary")
    ArrSource = Range("A2", [A65536].End(3))
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = ",*(.+?)\[\s*(\d+)\s*\]"
        For i = 1 To UBound(ArrSource, 1)
            tmp = ArrSource(i, 1)
            If .test(tmp) Then
                Set objmatch = .Execute(tmp)
                For Each Item In objmatch
                    TenHang = Application.Trim(Item.submatches(0))
                    Sluong = Val(Item.submatches(1))
                    If Not dic.exists(TenHang) Then
                        j = j + 1
                        dic.Add TenHang, j
                        ArrResult(j, 1) = TenHang
                        ArrResult(j, 2) = Sluong
                    Else
                       n = dic.Item(TenHang)
                       ArrResult(n, 2) = Sluong + ArrResult(n, 2)
                    End If
                Next
            End If
        Next
    End With
    For i = 1 To j
        strResult = strResult & ArrResult(i, 1) & vbTab & ArrResult(i, 2) & vbLf
    Next
    MsgBox strResult: Range("B3").Resize(50, 2) = ArrResult
    Set dic = Nothing
End Sub

Làm thế nào để có thể viết được code như thế này vậy Em rất muốn mà không biết học từ đâu và học ra sao

 

[hungpecc1]

Làm thế nào để có thể viết được code như thế này vậy Em rất muốn mà không biết học từ đâu và học ra sao

tìm tài liệu trên diễn đàn, học từ cơ bản đến nâng cao, có chỗ nào vướng mắc thì hỏi các thành viên trên diễn đàn !