Code VBA cộng dộn SL trong 1 ô khi chưa biết trước tên hàng

Ducminhpro · 6/8/20

Xin chào mọi người !
Tôi có 1 file excel tôi muốn cộng dồn số lượng tại ô G4 với điều kiện từ ngày đến ngày tại ô E4,F4 trong vùng dữ liệu B4:C50000. Nhưng do tôi chưa biết tên hàng trước nên không thể dùng SUmif được. Tôi nhờ mọi người giúp viết Code VBA để cộng được như ảnh bên dưới. Tôi cảm ơn !

thnghiachau · 6/8/20

Ducminhpro đã viết:
Xin chào mọi người !
Tôi có 1 file excel tôi muốn cộng dồn số lượng tại ô G4 với điều kiện từ ngày đến ngày tại ô E4,F4 trong vùng dữ liệu B4:C50000. Nhưng do tôi chưa biết tên hàng trước nên không thể dùng SUmif được. Tôi nhờ mọi người giúp viết Code VBA để cộng được như ảnh bên dưới. Tôi cảm ơn !

View attachment 242487

theo cái hình của bạn thì mới nhìn vào Coca có tới 3 lận??? từ ngày tới ngày chứ đâu phải trong ngày đâu hả????

Ba Tê · 6/8/20

Ducminhpro đã viết:
Xin chào mọi người !
Tôi có 1 file excel tôi muốn cộng dồn số lượng tại ô G4 với điều kiện từ ngày đến ngày tại ô E4,F4 trong vùng dữ liệu B4:C50000. Nhưng do tôi chưa biết tên hàng trước nên không thể dùng SUmif được. Tôi nhờ mọi người giúp viết Code VBA để cộng được như ảnh bên dưới. Tôi cảm ơn !

View attachment 242487

Cái này là đếm chứ khộng phải cộng dồn.
Dùng hàm tự tạo:

Phuocam · 6/8/20

Thử UDF:

Mã:

Public Function LietKe(ByVal Rng As Range, ByVal StartDate As Long, ByVal EndDate As Long) As String
Dim Dic As Object, arrData, i As Long, e

Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
arrData = Rng.Value2

For i = 1 To UBound(arrData, 1)
    If arrData(i, 1) >= StartDate And arrData(i, 1) <= EndDate Then
        Dic.Item(arrData(i, 2)) = Dic.Item(arrData(i, 2)) + 1
    End If
Next i
For Each e In Dic.keys
    LietKe = LietKe & IIf(LietKe = "", "", "; ") & e & "( " & Dic.Item(e) & " )"
Next e

End Function

Ducminhpro · 6/8/20

thnghiachau đã viết:
theo cái hình của bạn thì mới nhìn vào Coca có tới 3 lận??? từ ngày tới ngày chứ đâu phải trong ngày đâu hả????

Xin lổi do mình nhầm

Nhattanktnn · 6/8/20

Ducminhpro đã viết:
Xin chào mọi người !
Tôi có 1 file excel tôi muốn cộng dồn số lượng tại ô G4 với điều kiện từ ngày đến ngày tại ô E4,F4 trong vùng dữ liệu B4:C50000. Nhưng do tôi chưa biết tên hàng trước nên không thể dùng SUmif được. Tôi nhờ mọi người giúp viết Code VBA để cộng được như ảnh bên dưới. Tôi cảm ơn !

View attachment 242487

Học đòi viết code:

PHP:

Sub congdon()
Dim sArr(), dArr(), DK1 As Date, DK2 As Date, i As Long, j As Long, k As Long, Res As String, Lr As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1")
    DK1 = .Range("E4").Value2
    DK2 = .Range("F4").Value2
    Lr = .Range("C" & Rows.Count).End(xlUp).Row
sArr = .Range("B4:C" & Lr).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 2)
If Lr = 3 Then MsgBox "Chua co du lieu": Exit Sub
For i = 1 To UBound(sArr)
    If sArr(i, 1) >= DK1 And sArr(i, 1) <= DK2 Then
        If Not Dic.exists(sArr(i, 2)) Then
                k = k + 1
                Dic.Add (sArr(i, 2)), k
                dArr(k, 1) = sArr(i, 2)
                dArr(k, 2) = 1
        Else
                dArr(Dic.Item(sArr(i, 2)), 2) = dArr(Dic.Item(sArr(i, 2)), 2) + 1
        End If
    End If
Next i
For j = 1 To k
Res = Res & ", " & dArr(j, 1) & "(" & dArr(j, 2) & ")"
Next j
Sheets("sheet1").Range("G4") = Res
End Sub

Mã:

Nhờ bác @Ba Tê và bác @phuocam chỉ giúp làm sao xóa dấu "," đầu tiên của kết quả (Em replace mà không được

)

Phuocam · 6/8/20

Sheets("sheet1").Range("G4") =Mid( Res,3)

thnghiachau · 6/8/20

Nhattanktnn đã viết:
Nhờ bác @Ba Tê và bác @phuocam chỉ giúp làm sao xóa dấu "," đầu tiên của kết quả (Em replace mà không được )

không biết mình làm thế này được không nhỉ...

Mã:

For j = 1 To k
    If Res <> "" then
        Res = Res & ", " & dArr(j, 1) & "(" & dArr(j, 2) & ")"
    else
        Res = dArr(j, 1) & "(" & dArr(j, 2) & ")"
    End If
Next j

Ducminhpro · 6/8/20

Ba Tê đã viết:
Cái này là đếm chứ khộng phải cộng dồn.
Dùng hàm tự tạo:

Cảm ơn bạn. Code chạy rất hay. cho mình hỏi khi mình dùng công thức vùng chọn trống trống =Gpe($B$4:$C$1000,E4,F4)
nó có thêm số 986 phía sau . Nhờ bạn sửa code lại bỏ số đó đi

Bài đã được tự động gộp: 6/8/20

phuocam đã viết:

Thử UDF:

Mã:

Public Function LietKe(ByVal Rng As Range, ByVal StartDate As Long, ByVal EndDate As Long) As String
Dim Dic As Object, arrData, i As Long, e

Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
arrData = Rng.Value2

For i = 1 To UBound(arrData, 1)
    If arrData(i, 1) >= StartDate And arrData(i, 1) <= EndDate Then
        Dic.Item(arrData(i, 2)) = Dic.Item(arrData(i, 2)) + 1
    End If
Next i
For Each e In Dic.keys
    LietKe = LietKe & IIf(LietKe = "", "", "; ") & e & "( " & Dic.Item(e) & " )"
Next e

End Function

Cảm ơn bạn. Nếu vùng tên hàng trống thì công thức đếm bị thừa 1 số ký tự lạ

Ba Tê · 6/8/20

thnghiachau đã viết:
không biết mình làm thế này được không nhỉ...

Mã:

For j = 1 To k If Res <> "" then Res = Res & ", " & dArr(j, 1) & "(" & dArr(j, 2) & ")" else Res = dArr(j, 1) & "(" & dArr(j, 2) & ")" End If Next j

Có thể viết thế này:

PHP:

For j = 1 To k
    Res = Res & IIf(Len(Res), ", ", "") & dArr(j, 1) & "(" & dArr(j, 2) & ")"
Next j

Phuocam · 6/8/20

Ducminhpro đã viết:
Cảm ơn bạn. Code chạy rất hay. cho mình hỏi khi mình dùng công thức vùng chọn trống trống =Gpe($B$4:$C$1000,E4,F4)
nó có thêm số 986 phía sau . Nhờ bạn sửa code lại bỏ số đó đi

Không có tên mặt hàng thì bán cái gì?

thnghiachau · 6/8/20

phuocam đã viết:
Không có tên mặt hàng thì bán cái gì?

bán hàng tự có...

Phuocam · 6/8/20

thnghiachau đã viết:
bán hàng tự có...

Tự có cũng có tên ...

Ducminhpro · 6/8/20

phuocam đã viết:
Không có tên mặt hàng thì bán cái gì?

Nếu không có tên thì Trống trống chứ. Ví dụ

Thay vì hiện số 3. Bạn cho nó trống trống luôn. không cần đếm trống trống

thnghiachau · 6/8/20

Ducminhpro đã viết:
Cảm ơn bạn. Nếu vùng tên hàng trống thì công thức đếm bị thừa 1 số ký tự lạ

bạn lấy $B$4:C$1000 luôn thì nó chơi luôn mấy ô không có dữ liệu mà....
làm toán trừ đi: 1000-14(có dữ liệu)=?????

Bài đã được tự động gộp: 6/8/20

Ducminhpro đã viết:
Nếu không có tên thì Trống trống chứ. Ví dụ

View attachment 242506
Thay vì hiện số 3. Bạn cho nó trống trống luôn. không cần đếm trống trống

số 3 đó là hàng ""

Ducminhpro · 6/8/20

thnghiachau đã viết:
View attachment 242505
bạn lấy $B$4:C$1000 luôn thì nó chơi luôn mấy ô không có dữ liệu mà....
làm toán trừ đi: 1000-14(có dữ liệu)=?????

ý mình là không cần đếm ô rổng. Chỉ đếm những tên hàng có Len >0 thôi. Còn rổng không cần hiện ra. Vì hiện ra cũng không có tác dụng. Vi mình chỉ muốn nhìn những tên hàng xuất hiện bao nhiêu lần thôi. Bỏ qua rổng

Bài đã được tự động gộp: 6/8/20

Nhattanktnn đã viết:

Học đòi viết code:

PHP:

Sub congdon()
Dim sArr(), dArr(), DK1 As Date, DK2 As Date, i As Long, j As Long, k As Long, Res As String, Lr As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1")
    DK1 = .Range("E4").Value2
    DK2 = .Range("F4").Value2
    Lr = .Range("C" & Rows.Count).End(xlUp).Row
sArr = .Range("B4:C" & Lr).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 2)
If Lr = 3 Then MsgBox "Chua co du lieu": Exit Sub
For i = 1 To UBound(sArr)
    If sArr(i, 1) >= DK1 And sArr(i, 1) <= DK2 Then
        If Not Dic.exists(sArr(i, 2)) Then
                k = k + 1
                Dic.Add (sArr(i, 2)), k
                dArr(k, 1) = sArr(i, 2)
                dArr(k, 2) = 1
        Else
                dArr(Dic.Item(sArr(i, 2)), 2) = dArr(Dic.Item(sArr(i, 2)), 2) + 1
        End If
    End If
Next i
For j = 1 To k
Res = Res & ", " & dArr(j, 1) & "(" & dArr(j, 2) & ")"
Next j
Sheets("sheet1").Range("G4") = Res
End Sub

Mã:

Nhờ bác @Ba Tê và bác @phuocam chỉ giúp làm sao xóa dấu "," đầu tiên của kết quả (Em replace mà không được

)

Code bạn vẫn chưa đúng nếu vùng tên hàng trống trống

Không cần đếm ô trông trống

Phuocam · 6/8/20

Thử thay dòng:

If arrData(i, 1) >= StartDate And arrData(i, 1) <= EndDate Then

bằng dòng:

If arrData(i, 1) >= StartDate And arrData(i, 1) <= EndDate And arrData(i, 2) <> "" Then

thnghiachau · 6/8/20

Ducminhpro đã viết:
ý mình là không cần đếm ô rổng. Chỉ đếm những tên hàng có Len >0 thôi. Còn rổng không cần hiện ra. Vì hiện ra cũng không có tác dụng. Vi mình chỉ muốn nhìn những tên hàng xuất hiện bao nhiêu lần thôi. Bỏ qua rổng

Vài lời với bạn:
Bài của bạn được rất nhiều bạn trong GPE giúp đỡ.
Để trân trọng điều này thì bạn phải xem xét từng cái code và chọn ra cái mà mình yêu thích/ thấy hay nhất.
và theo cái này thì bạn sẽ hỏi tác giả về cái bạn muốn...
Bạn không nên đụng gì hỏi đó dụng bài nào cũng hỏi, đụng ai cũng hỏi...
như vậy người ta sẽ cảm thấy... mình trong mớ hỗn độn và cũng chẳng buồn trả lời bạn !!!!

Nhattanktnn · 6/8/20

Dưới sự trợ giúp, góp ý của bác @Ba Tê , @phuocam ,@thnghiachau thì mình sửa lại code (loại tên hàng trống như bạn nói). Đây là code kiểu "xe tập lái" nên bạn xem tham khảo, xài được thì xài nha:

PHP:

Sub congdon()
Dim sArr(), dArr(), DK1 As Date, DK2 As Date, i As Long, j As Long, k As Long, Res As String, Lr As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
With Sheets("Sheet1")
    DK1 = .Range("E4").Value2
    DK2 = .Range("F4").Value2
    Lr = .Range("C" & Rows.Count).End(xlUp).Row
sArr = .Range("B4:C" & Lr).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 2)
If Lr = 3 Then MsgBox "Chua co du lieu": Exit Sub
For i = 1 To UBound(sArr)
    If sArr(i, 1) >= DK1 And sArr(i, 1) <= DK2 And sArr(i, 2) <> "" Then
        If Not Dic.exists(sArr(i, 2)) Then
                k = k + 1
                Dic.Add (sArr(i, 2)), k
                dArr(k, 1) = sArr(i, 2)
                dArr(k, 2) = 1
        Else
                dArr(Dic.Item(sArr(i, 2)), 2) = dArr(Dic.Item(sArr(i, 2)), 2) + 1
        End If
    End If
Next i
For j = 1 To k
Res = Res & ", " & dArr(j, 1) & "(" & dArr(j, 2) & ")"
'Res = Res & IIf(Len(Res), ", ", "") & dArr(j, 1) & "(" & dArr(j, 2) & ")"
Next j
Sheets("sheet1").Range("G4") = Mid(Res, 3)
End Sub

hocexcel_1991 · 6/8/20

Ducminhpro đã viết:
Xin chào mọi người !
Tôi có 1 file excel tôi muốn cộng dồn số lượng tại ô G4 với điều kiện từ ngày đến ngày tại ô E4,F4 trong vùng dữ liệu B4:C50000. Nhưng do tôi chưa biết tên hàng trước nên không thể dùng SUmif được. Tôi nhờ mọi người giúp viết Code VBA để cộng được như ảnh bên dưới. Tôi cảm ơn !

View attachment 242487

1 cách khác cho bạn tham khảo, dùng Power Query

Code VBA cộng dộn SL trong 1 ô khi chưa biết trước tên hàng

Thành viên bị đình chỉ hoạt động

File đính kèm

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên mới

Thành viên bị đình chỉ hoạt động

Thành viên gắn bó

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên bị đình chỉ hoạt động

Cạo Rồi Khỏi Gội

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Thành viên bị đình chỉ hoạt động

File đính kèm

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên bị đình chỉ hoạt động

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên gắn bó

Bắt đầu học Excel

File đính kèm