Giúp sửa code cộng số lượng là số lẻ (1 người xem)

[minhtuan55]

Code của mình Ok hết nếu là Số nguyện ví dụ: Cà phê đá [4] , còn số lẻ thì không đúng ví dụ: Cà phê đá[2.5] . Mình đang cần rất gấp rất mong mọi người giúp đở

 

[minhtuan55]

Hi vọng với bạn là đừng bao giờ thốt lên câu này lần nữa nhá:

Không có lần sau đâu

Public Sub GPE()
Dim Dic As Object, Tem As String, I As Long, J As Long, K As Long
Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("B4", Range("B4").End(4)).Value
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
        Tam = Split(Trim(sArr(I, 1)), ",")
        For J = 0 To UBound(Tam)
        If Len(Tam(J)) > 1 Then
        Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))
        N = Trim(Mid(Tam(J), InStr(1, Tam(J), "[") + 1, Len(Tam(J))))
        Qty = Val(Left(N, Len(N) - 1))
            If Not Dic.exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                dArr(K, 1) = Tem
                dArr(K, 2) = Qty
            Else
                dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) + Qty
            End If
        End If
        Next J
    End If
Next I
    If K Then Range("D4").Resize(K, 2).Value = dArr
End Sub

Dạ em mới đăng ký diễn đàn nên chưa biết điều đó. em xin lổi anh. lần sau em không dùng những từ ngử đó nữa. Code của anh đúng 99% rồi còn 1 chút nửa anh giúp em luôn nhé. Anh ơi em muốn thay đổi dữ liệu đầu vào là từ B4:B30 thì em thay đổi chổ nào. Và khi Vùng B4: B30 không có dữ liệu thì Đầu ra cũng phải Trống luôn a. Thank anh nhiều quá

 

[minhtuan55]

Hi vọng với bạn là đừng bao giờ thốt lên câu này lần nữa nhá:

Không có lần sau đâu

Public Sub GPE()
Dim Dic As Object, Tem As String, I As Long, J As Long, K As Long
Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("B4", Range("B4").End(4)).Value
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
        Tam = Split(Trim(sArr(I, 1)), ",")
        For J = 0 To UBound(Tam)
        If Len(Tam(J)) > 1 Then
        Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))
        N = Trim(Mid(Tam(J), InStr(1, Tam(J), "[") + 1, Len(Tam(J))))
        Qty = Val(Left(N, Len(N) - 1))
            If Not Dic.exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                dArr(K, 1) = Tem
                dArr(K, 2) = Qty
            Else
                dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) + Qty
            End If
        End If
        Next J
    End If
Next I
    If K Then Range("D4").Resize(K, 2).Value = dArr
End Sub

Anh ơi em tự Mò nảy giờ cũng được rồi. Mà không biết đúng hay sai, Anh xem giúp em nhé

Sub Locsole()
Range("D4:E30").ClearContents ' xoa Du lieu dau ra truoc
Dim Dic As Object, Tem As String, I As Long, J As Long, K As Long
Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("B4:B30").Value ' thay doi dau vao
For I = 1 To UBound(sArr)
If sArr(I, 1) <> Empty Then
Tam = Split(Trim(sArr(I, 1)), ",")
For J = 0 To UBound(Tam)
If Len(Tam(J)) > 1 Then
Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))
N = Trim(Mid(Tam(J), InStr(1, Tam(J), "[") + 1, Len(Tam(J))))
Qty = Val(Left(N, Len(N) - 1))
If Not Dic.exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = Tem
dArr(K, 2) = Qty
Else
dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) + Qty
End If
End If
Next J
End If
Next I
If K Then Range("D4").Resize(K, 2).Value = dArr
End Sub

 

[concogia]

Code của mình Ok hết nếu là Số nguyện ví dụ: Cà phê đá [4] , còn số lẻ thì không đúng ví dụ: Cà phê đá[2.5] . Mình đang cần rất gấp rất mong mọi người giúp đở

Bài này viết code không khó, chạy nhanh (khoảng 2000 dòng dữ liệu) cũng không khó, chỉ khi nhập dữ liệu thì phải nhập đúng kiểu, đúng định dạng, thống nhất một kiểu nhập
Trong topic kia của bạn ở bảng có số lẻ bạn nhập:

Cà phê Cacao [1.5], Cà phê đen [4,5], Cà phê sữa [5,5], Cà phê sữa Cacao [2,5], 7 - up [2,5], Coca [2,5], Numberone [2,5],

Lúc thì "chấm", lúc thì "phẩy", nếu không lường trước khi viết code dễ bị "tèo" lắm
Thân

 

[minhtuan55]

Muốn gắn chết đầu vào thì sửa câu

sArr = Range("B4", Range("B4").End(4)).Value

Thành

sArr = Range("B4:B30").Value

Đúng rồi...Không có dữ liệu thì code bị lỗi...vì không có gì hết... tất nhiên là phải có dữ liệu đầu vào...Nếu không có thì viết code và chạy code làm gì...=> Bị Hâm ah???

Anh ơi em mới Test có thêm 1 lỗi rất nghiêm trọng. Là khi tên hàng em có dấu phẩy là nó báo lỗi ở dòng
Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))

Ví du: Cà phê đá [5] là ok
Ví du: Cà phê, đá [5] là báo lỗi
Anh xem chỉnh lại giúp em

 

[minhtuan55]

Bài này viết code không khó, chạy nhanh (khoảng 2000 dòng dữ liệu) cũng không khó, chỉ khi nhập dữ liệu thì phải nhập đúng kiểu, đúng định dạng, thống nhất một kiểu nhập
Trong topic kia của bạn ở bảng có số lẻ bạn nhập:

Lúc thì "chấm", lúc thì "phẩy", nếu không lường trước khi viết code dễ bị "tèo" lắm
Thân

Cấu trúc chuẩn nó sẽ như thế này a

Tên hàng a, [số lượng 1], tên hàng b, [số lượng 2]..........Tên hàng n

 

[minhtuan55]

Bắt buộc bạn phải chuẩn hóa dữ liệu. Đã ngăn cách món bằng dấu phẩy thì tên món phải loại bỏ dấu phẩy...Thế thôi,không thể kiều muón gõ gì thì gõ được...

Anh ơi em chưa hiểu chổ này mong anh giúp em
Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String

Số 10000 nghỉa là gi a

 

[concogia]

Anh ơi em mới Test có thêm 1 lỗi rất nghiêm trọng. Là khi tên hàng em có dấu phẩy là nó báo lỗi ở dòng
Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))

Ví du: Cà phê đá [5] là ok
Ví du: Cà phê, đá [5] là báo lỗi
Anh xem chỉnh lại giúp em

Đưa lại file có dữ liệu chuẩn của bạn lên xem sao, làm một lần khỏi sửa

 

[minhtuan55]

Đưa lại file có dữ liệu chuẩn của bạn lên xem sao, làm một lần khỏi sửa

Được rồi anh, tên hàng em sẽ không dùng dấu phẩy nước mà thay vào dấu - là ok. Anh giúp em giải thích cái chổ Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String

10000 đó nghia la gi

 

[minhtuan55]

Số 10000 nghĩa là: đọc bằng chữ: mười ngàn ....kế hợp vào mảng thì gọi là tạo 1 mảng có 10 ngàn dòng và có 2 cột...Thế thôi...

Nói chung bạn chưa có căn bản gì về code thì nên tìm đọc trước chứ đừng hỏi vậy...xa xôi lắm...

----------------
Quay về vấn đề trên: nếu tên sản phẩm của bạn có dấu phẩy...thì bắt buộc bạn nhập dấu phẩy ngăn cách món phải sau dấu ] thì làm được...có nghĩa là phải theo kiểu như vậy...

Cà phê Cacao [1], Cà phê đen, đá [4.5],, Cà phê sữa [5], Cà phê sữa Cacao [2], 7 - up [2], Coca [2], Numberone [2]

Vậy ta dựa vào 2 ký tự liên tiếp mà xử ], Nếu Ok thì phản hồi...tôi sửa lại code

Ok đúng ý em rồi. Vì nhiều khi người ta nhập nhầm dấu phẩy thì cũng không sao. Thank bác nhiệt tình với em quá

 

[minhtuan55]

Số 10000 nghĩa là: đọc bằng chữ: mười ngàn ....kế hợp vào mảng thì gọi là tạo 1 mảng có 10 ngàn dòng và có 2 cột...Thế thôi...

Nói chung bạn chưa có căn bản gì về code thì nên tìm đọc trước chứ đừng hỏi vậy...xa xôi lắm...

----------------
Quay về vấn đề trên: nếu tên sản phẩm của bạn có dấu phẩy...thì bắt buộc bạn nhập dấu phẩy ngăn cách món phải sau dấu ] thì làm được...có nghĩa là phải theo kiểu như vậy...

Cà phê Cacao [1], Cà phê đen, đá [4.5],, Cà phê sữa [5], Cà phê sữa Cacao [2], 7 - up [2], Coca [2], Numberone [2]

Vậy ta dựa vào 2 ký tự liên tiếp mà xử ], Nếu Ok thì phản hồi...tôi sửa lại code

Cho em hỏi 2 Anh học Code ở chổ nào mà giỏi vậy. Em muốn sau này em cũng tự viết code theo ý mình thì em học ở đâu

 

[dhn46]

Người viết cho bạn Code này đã gần như hoàn chỉnh rồi, tại sao bạn không nhờ lại người đó.

Mạn phép tác giả sửa là 1 vài chỗ nhỏ theo yêu cầu chủ topic

1/ Sửa

Sluong&

thành

Sluong#

2/ Sửa

",*(.+?)\[\s*(\d+)\s*\]"

thành

",*(.+?)\[\s*(\d+\.*,*\d*)\s*\]"

3/ Sửa

Application.Trim(Item.submatches(0))

thành

Application.Trim(Replace(Item.submatches(0), ",", ""))

 

[minhtuan55]

Vậy bạn sửa code trong file thành vầy...

Sub Locsole()
Dim Dic As Object, Tem As String, I As Long, J As Long, K As Long
Dim sArr, dArr(1 To 10000, 1 To 2), Qty As Double, Tam, N As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("B4:B30").Value
Range("D4:E30").ClearContents
For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
        Tam = Split(Trim(sArr(I, 1)), "],")
        For J = 0 To UBound(Tam)
        If Len(Tam(J)) > 1 Then
        Tem = Trim(Left(Tam(J), InStr(1, Tam(J), "[") - 1))
        N = Trim(Mid(Tam(J), InStr(1, Tam(J), "[") + 1, Len(Tam(J))))
        Qty = Val(N)
            If Not Dic.exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                dArr(K, 1) = Tem
                dArr(K, 2) = Qty
            Else
                dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) + Qty
            End If
        End If
        Next J
    End If
Next I
    If K Then Range("D4").Resize(K, 2).Value = dArr
End Sub

Quá chỉnh xác theo ý mình, Thank bác nhiều