Tách số lượng theo từng mã hàng?

Liên hệ QC
Hoàng Nhật Phương

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,895
Được thích
1,219
Xin chào các bạn,
Vì tập tin rất nhiều dữ liệu vì vậy mà tôi muốn sử dụng code thay cho công thức.
Bài toán và kết quả mong muốn tôi xin được nêu trong tập tin đính kèm.
Nhờ các bạn xem giúp ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Hiện OT đang sử dụng code bài 15,16 để xử lý cho công việc.
Nhưng bây giờ có một chút thay đổi,OT muốn tổng hợp thêm 1 điều kiện nữa cách làm vẫn như cũ, chỉ thay đổi nếu nếu trong cột C tại các sheet con:I.,II.,III.,...,VIII có giá trị = "01ECC" thì sẽ tổng hợp dữ liệu vào Sheets("Tonghop01ECC") còn nếu <> "01ECC" thì sẽ tổng hợp hết vào Sheets("Tonghop1").
Nhờ các bạn xem file gửi kèm và giúp đỡ OT xử lý trường hợp trên với ạ.
Nhấp chuột vào đây để mở rộng...
Nói vài lời khó nghe chút nhưng thật sự khi nhìn vào bố cục của bảng tính, cách đặt tên sheet, và kiểu dữ liệu trong file thì rõ ràng là không được khoa học lắm. Nếu là mình thì file này chỉ còn lại 2 sheet. Cho dù dùng hàm hay code đều hết sức đơn giản.
 
Upvote 0
quanghai1969 đã viết:
Nói vài lời khó nghe chút nhưng thật sự khi nhìn vào bố cục của bảng tính, cách đặt tên sheet, và kiểu dữ liệu trong file thì rõ ràng là không được khoa học lắm. Nếu là mình thì file này chỉ còn lại 2 sheet. Cho dù dùng hàm hay code đều hết sức đơn giản.
Nhấp chuột vào đây để mở rộng...

Xin chào quanghai1969,
Cảm ơn anh Quang Hải đã quan tâm và góp ý ạ,OT hiểu và cảm nhận được vấn đề góp ý của anh ạ.
Thực sự trong thực tế công việc của OT đang va phải có rất nhiều mẫu file mà OT cũng cảm nhận được CSDL bố trí không hợp lý dẫn đến việc tính toán tổng hợp dữ liệu rất khó khăn.
Nhưng vì file có liên quan đến cả hệ thống (đến các file khác) hoặc liên quan khách hàng hoặc do cấp trên yêu cầu vì thế bản thân OT không có cách nào thương thuyết để thay đổi được.
Rất mong anh thông cảm và nhận được thêm sự giúp đỡ từ anh và các bạn.
Trân trọng cảm ơn
Oanh Thơ
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Hiện OT đang sử dụng code bài 15,16 để xử lý cho công việc.
Nhưng bây giờ có một chút thay đổi,OT muốn tổng hợp thêm 1 điều kiện nữa cách làm vẫn như cũ, chỉ thay đổi nếu nếu trong cột C tại các sheet con:I.,II.,III.,...,VIII có giá trị = "01ECC" thì sẽ tổng hợp dữ liệu vào Sheets("Tonghop01ECC") còn nếu <> "01ECC" thì sẽ tổng hợp hết vào Sheets("Tonghop1").
Nhờ các bạn xem file gửi kèm và giúp đỡ OT xử lý trường hợp trên với ạ.
Nhấp chuột vào đây để mở rộng...
Đề phòng 2 sheet kết quả có các dòng mã khác nhau nên phải dùng Dic riêng
Mã: 
Sub GPE()
  Dim Sh As Worksheet, sArr(), Res(), Res2(), S As Variant, Dic As Object
  Dim HM As String, Ma As String, SL, Thang As String, DG, tmp, N As Double
  Dim sRow As Long, sRow2 As Long, i As Long, iRow As Long
  Dim sCol As Long, sCol2 As Long, j As Long, jCol As Long
  Const dk As String = "01ECC"

  With Sheets("Tonghop1")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value
    sRow = UBound(Res, 1): sCol = UBound(Res, 2)
  End With
  Set Dic = CreateObject("scripting.dictionary")
  For j = 2 To 13
    Dic.Add Format(Res(1, j), "mm/yyyy"), j
  Next j
  For i = 2 To sRow
    Ma = CStr(Res(i, 1))
    If Len(Ma) > 0 Then Dic.Add Ma, i
  Next i
  With Sheets("Tonghop01ECC")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res2 = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value
    sRow2 = UBound(Res2, 1): sCol2 = UBound(Res2, 2)
  End With
  For i = 2 To sRow2
    Ma = CStr(Res2(i, 1))
    If Len(Ma) > 0 Then Dic.Add "#" & Ma & "#", i
  Next i
  For Each Sh In ActiveWorkbook.Sheets
    If Left(Sh.Name, 7) <> "Tonghop" Then
      eRow = Sh.Range("U" & Rows.Count).End(xlUp).Row
      If eRow > 4 Then
        sArr = Sh.Range("C5:Z" & eRow).Value
        For i = 1 To UBound(sArr, 1)
          HM = CStr(sArr(i, 1)):       tmp = sArr(i, 19):    SL = sArr(i, 20)
          Thang = CStr(sArr(i, 21)):   DG = sArr(i, 24)
          If Len(HM) > 0 And Len(tmp) > 0 And Len(SL) > 0 And Len(Thang) > 0 And Len(DG) > 0 Then
            If Not IsNumeric(DG) Then DG = 6
            jCol = Dic.Item(Thang) + (DG - 1) * 14
            S = Split(Replace("&" & tmp, " ", ""), "&")
            N = SL / UBound(S)
            For j = 1 To UBound(S)
              If HM = dk Then
                iRow = Dic.Item("#" & S(j) & "#")
                If iRow > 0 Then Res2(iRow, jCol) = Res2(iRow, jCol) + N
              Else
                iRow = Dic.Item(S(j))
                If iRow > 0 Then Res(iRow, jCol) = Res(iRow, jCol) + N
              End If
            Next j
          End If
        Next i
      End If
    End If
  Next Sh
  Sheets("Tonghop1").Range("K6").Resize(sRow, sCol) = Res
  Sheets("Tonghop01ECC").Range("K6").Resize(sRow2, sCol2) = Res2
End Sub
 
Upvote 0
HieuCD đã viết:
Đề phòng 2 sheet kết quả có các dòng mã khác nhau nên phải dùng Dic riêng
Mã: 
Sub GPE()
  Dim Sh As Worksheet, sArr(), Res(), Res2(), S As Variant, Dic As Object
  Dim HM As String, Ma As String, SL, Thang As String, DG, tmp, N As Double
  Dim sRow As Long, sRow2 As Long, i As Long, iRow As Long
  Dim sCol As Long, sCol2 As Long, j As Long, jCol As Long
  Const dk As String = "01ECC"

  With Sheets("Tonghop1")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value
    sRow = UBound(Res, 1): sCol = UBound(Res, 2)
  End With
  Set Dic = CreateObject("scripting.dictionary")
  For j = 2 To 13
    Dic.Add Format(Res(1, j), "mm/yyyy"), j
  Next j
  For i = 2 To sRow
    Ma = CStr(Res(i, 1))
    If Len(Ma) > 0 Then Dic.Add Ma, i
  Next i
  With Sheets("Tonghop01ECC")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res2 = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value
    sRow2 = UBound(Res2, 1): sCol2 = UBound(Res2, 2)
  End With
  For i = 2 To sRow2
    Ma = CStr(Res2(i, 1))
    If Len(Ma) > 0 Then Dic.Add "#" & Ma & "#", i
  Next i
  For Each Sh In ActiveWorkbook.Sheets
    If Left(Sh.Name, 7) <> "Tonghop" Then
      eRow = Sh.Range("U" & Rows.Count).End(xlUp).Row
      If eRow > 4 Then
        sArr = Sh.Range("C5:Z" & eRow).Value
        For i = 1 To UBound(sArr, 1)
          HM = CStr(sArr(i, 1)):       tmp = sArr(i, 19):    SL = sArr(i, 20)
          Thang = CStr(sArr(i, 21)):   DG = sArr(i, 24)
          If Len(HM) > 0 And Len(tmp) > 0 And Len(SL) > 0 And Len(Thang) > 0 And Len(DG) > 0 Then
            If Not IsNumeric(DG) Then DG = 6
            jCol = Dic.Item(Thang) + (DG - 1) * 14
            S = Split(Replace("&" & tmp, " ", ""), "&")
            N = SL / UBound(S)
            For j = 1 To UBound(S)
              If HM = dk Then
                iRow = Dic.Item("#" & S(j) & "#")
                If iRow > 0 Then Res2(iRow, jCol) = Res2(iRow, jCol) + N
              Else
                iRow = Dic.Item(S(j))
                If iRow > 0 Then Res(iRow, jCol) = Res(iRow, jCol) + N
              End If
            Next j
          End If
        Next i
      End If
    End If
  Next Sh
  Sheets("Tonghop1").Range("K6").Resize(sRow, sCol) = Res
  Sheets("Tonghop01ECC").Range("K6").Resize(sRow2, sCol2) = Res2
End Sub
Nhấp chuột vào đây để mở rộng...

Xin chào bác HieuCD,cháu đã chạy thử code trên kết quả xuất ra đúng kết quả mà cháu mong muốn rồi ạ.
Nhìn code trên của bác cháu mà cháu không hiểu một chút gì hết o_O
Cháu cảm ơn bác & chúc bác sức khỏe ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào bác HieuCD,cháu đã chạy thử code trên kết quả xuất ra đúng kết quả mà cháu mong muốn rồi ạ.
Nhìn code trên của bác cháu mà cháu không hiểu một chút gì hết o_O
Cháu cảm ơn bác & chúc bác sức khỏe ạ.
Nhấp chuột vào đây để mở rộng...
Xem ghi chú trên code
Mã: 
Sub GPE()
  Dim Sh As Worksheet, sArr(), Res(), Res2(), S As Variant, Dic As Object
  Dim HM As String, Ma As String, SL, Thang As String, DG, tmp, N As Double
  Dim sRow As Long, sRow2 As Long, i As Long, iRow As Long
  Dim sCol As Long, sCol2 As Long, j As Long, jCol As Long, dCol As Long
  Const dk As String = "01ECC" ' Dieu kien xet Sheet ket qua

  With Sheets("Tonghop1")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    dCol = .Range("K6:X6").Columns.Count 'Só cot cua 1 muc danh giá trong bang ket qua ket qua
    Res = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop1")
    sRow = UBound(Res, 1): sCol = UBound(Res, 2)
  End With
  Set Dic = CreateObject("scripting.dictionary")
  For j = 2 To 13 'Duyet qua các thang
    Dic.Add Format(Res(1, j), "mm/yyyy"), j 'Thu tu cot theo thang cua muc danh gia dau tien
  Next j
  For i = 2 To sRow
    Ma = CStr(Res(i, 1))
    If Len(Ma) > 0 Then Dic.Add Ma, i 'Add thu tu dòng ket qua Sheets("Tonghop1")
  Next i
  With Sheets("Tonghop01ECC")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res2 = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop01ECC")
    sRow2 = UBound(Res2, 1): sCol2 = UBound(Res2, 2)
  End With
  For i = 2 To sRow2
    Ma = CStr(Res2(i, 1))
    If Len(Ma) > 0 Then Dic.Add "#" & Ma & "#", i 'Add thu tu dòng ket qua Sheets("Tonghop01ECC")
  Next i
  For Each Sh In ActiveWorkbook.Sheets
    If Left(Sh.Name, 7) <> "Tonghop" Then
      eRow = Sh.Range("U" & Rows.Count).End(xlUp).Row 'Dòng cuoi
      If eRow > 4 Then
        sArr = Sh.Range("C5:Z" & eRow).Value
        For i = 1 To UBound(sArr, 1)
          HM = CStr(sArr(i, 1)) 'Hang muc
          tmp = sArr(i, 19) 'Ma hang
          SL = sArr(i, 20) 'So luong
          Thang = CStr(sArr(i, 21)) 'Tháng
          DG = sArr(i, 24) 'muc danh giá
          If Len(HM) > 0 And Len(tmp) > 0 And Len(SL) > 0 And Len(Thang) > 0 And Len(DG) > 0 Then ' neu có du lieu
            If Not IsNumeric(DG) Then DG = 6 'Neu khong phai là so, là muc danh giá thu 6
            jCol = Dic.Item(Thang) + (DG - 1) * dCol 'thu tu cot ket qua
            S = Split(Replace("&" & tmp, " ", ""), "&") ' mang cac ma hang
            N = SL / UBound(S) 'So luong tung ma hang
            For j = 1 To UBound(S) 'duyet qua tung ma hang
              If HM = dk Then 'ket qua Sheets("Tonghop01ECC")
                iRow = Dic.Item("#" & S(j) & "#") 'Thu tu dòng ket qua
                If iRow > 0 Then Res2(iRow, jCol) = Res2(iRow, jCol) + N
              Else 'ket qua Sheets("Tongho1")
                iRow = Dic.Item(S(j)) 'Thu tu dòng ket qua
                If iRow > 0 Then Res(iRow, jCol) = Res(iRow, jCol) + N
              End If
            Next j
          End If
        Next i
      End If
    End If
  Next Sh
  Sheets("Tonghop1").Range("K6").Resize(sRow, sCol) = Res
  Sheets("Tonghop01ECC").Range("K6").Resize(sRow2, sCol2) = Res2
End Sub
 
Upvote 0
HieuCD đã viết:
Xem ghi chú trên code
Mã: 
Sub GPE()
  Dim Sh As Worksheet, sArr(), Res(), Res2(), S As Variant, Dic As Object
  Dim HM As String, Ma As String, SL, Thang As String, DG, tmp, N As Double
  Dim sRow As Long, sRow2 As Long, i As Long, iRow As Long
  Dim sCol As Long, sCol2 As Long, j As Long, jCol As Long, dCol As Long
  Const dk As String = "01ECC" ' Dieu kien xet Sheet ket qua

  With Sheets("Tonghop1")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    dCol = .Range("K6:X6").Columns.Count 'Só cot cua 1 muc danh giá trong bang ket qua ket qua
    Res = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop1")
    sRow = UBound(Res, 1): sCol = UBound(Res, 2)
  End With
  Set Dic = CreateObject("scripting.dictionary")
  For j = 2 To 13 'Duyet qua các thang
    Dic.Add Format(Res(1, j), "mm/yyyy"), j 'Thu tu cot theo thang cua muc danh gia dau tien
  Next j
  For i = 2 To sRow
    Ma = CStr(Res(i, 1))
    If Len(Ma) > 0 Then Dic.Add Ma, i 'Add thu tu dòng ket qua Sheets("Tonghop1")
  Next i
  With Sheets("Tonghop01ECC")
    .Range("L7:W2222,Z7:AK2222,AN7:AY2222,BB7:BM2222,BP7:CA2222,CD7:CO2222").ClearContents
    Res2 = .Range("K6:CO" & .Range("K" & Rows.Count).End(xlUp).Row).Value 'Mang ket qua Sheets("Tonghop01ECC")
    sRow2 = UBound(Res2, 1): sCol2 = UBound(Res2, 2)
  End With
  For i = 2 To sRow2
    Ma = CStr(Res2(i, 1))
    If Len(Ma) > 0 Then Dic.Add "#" & Ma & "#", i 'Add thu tu dòng ket qua Sheets("Tonghop01ECC")
  Next i
  For Each Sh In ActiveWorkbook.Sheets
    If Left(Sh.Name, 7) <> "Tonghop" Then
      eRow = Sh.Range("U" & Rows.Count).End(xlUp).Row 'Dòng cuoi
      If eRow > 4 Then
        sArr = Sh.Range("C5:Z" & eRow).Value
        For i = 1 To UBound(sArr, 1)
          HM = CStr(sArr(i, 1)) 'Hang muc
          tmp = sArr(i, 19) 'Ma hang
          SL = sArr(i, 20) 'So luong
          Thang = CStr(sArr(i, 21)) 'Tháng
          DG = sArr(i, 24) 'muc danh giá
          If Len(HM) > 0 And Len(tmp) > 0 And Len(SL) > 0 And Len(Thang) > 0 And Len(DG) > 0 Then ' neu có du lieu
            If Not IsNumeric(DG) Then DG = 6 'Neu khong phai là so, là muc danh giá thu 6
            jCol = Dic.Item(Thang) + (DG - 1) * dCol 'thu tu cot ket qua
            S = Split(Replace("&" & tmp, " ", ""), "&") ' mang cac ma hang
            N = SL / UBound(S) 'So luong tung ma hang
            For j = 1 To UBound(S) 'duyet qua tung ma hang
              If HM = dk Then 'ket qua Sheets("Tonghop01ECC")
                iRow = Dic.Item("#" & S(j) & "#") 'Thu tu dòng ket qua
                If iRow > 0 Then Res2(iRow, jCol) = Res2(iRow, jCol) + N
              Else 'ket qua Sheets("Tongho1")
                iRow = Dic.Item(S(j)) 'Thu tu dòng ket qua
                If iRow > 0 Then Res(iRow, jCol) = Res(iRow, jCol) + N
              End If
            Next j
          End If
        Next i
      End If
    End If
  Next Sh
  Sheets("Tonghop1").Range("K6").Resize(sRow, sCol) = Res
  Sheets("Tonghop01ECC").Range("K6").Resize(sRow2, sCol2) = Res2
End Sub
Nhấp chuột vào đây để mở rộng...
Híc, cháu sẽ tìm hiểu từng chút một,những vấn đề cháu chưa hiểu rất mong lại nhận được sự giúp đỡ của bác ạ.
Cháu cảm ơn bác HieuCD nhiều nhiều.
Oanh Thơ.
 
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

GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
    • Yêu thích
Trả lời
4
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
N
Vẽ đường tròn bám theo 1 Polyline
Trả lời
1
Đọc
27
huhumalu
H
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
1
Đọc
104
thopd
T
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
9
Đọc
167
ptm0412
ptm0412
OverAC
TPHCM - Gặp mặt đầu năm Ất Tỵ 18g ngày 8/2
    • Thích
    • Ngạc nhiên
Trả lời
1
Đọc
63
tungnguyen_kt
tungnguyen_kt
ptm0412
  • Question Question
Cách lấy link file excel nguồn cho Power query từ Onedrive, Google drive
    • Thích
    • Yêu thích
Trả lời
7
Đọc
3K
pxhieu1993
P
Y
Nhờ các anh chị xem giúp Hàm Sumproduct
Trả lời
0
Đọc
26
yoomi
Y
H
Không hiển thị công thức của các sheet
Trả lời
0
Đọc
23
hienxh_1979
H
dinhnhat91
  • Question Question
VBA Lỗi runtime error 9 subscript out of range
Trả lời
4
Đọc
98
ongke0711
ongke0711
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
1
Đọc
550
PhanTuHuong
PhanTuHuong
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
0
Đọc
60
Việt Nguyễn 86
Việt Nguyễn 86
K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
59
khanhvinhdai1
K
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
52
Đọc
103K
khanhvinhdai1
K
Huyen9
Lỗi không mailings được.
Trả lời
3
Đọc
91
vanle33
vanle33
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
310
Đọc
23K
kunkoi9390
K
K
Có ai giúp mình lấy kết quả xổ số miền nam về file excel
Trả lời
0
Đọc
48
khanhvinhdai1
K
ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
5
Đọc
2K
ptm0412
ptm0412
H
Công thức tìm kết quả
Trả lời
11
Đọc
130
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom