Nhờ giúp đỡ sửa mã tìm kiếm và tính tổng theo điều kiện!

Liên hệ QC
theanhst92

theanhst92

Thành viên hoạt động
Tham gia
31/3/16
Bài viết
134
Được thích
15
Kính gửi anh chị trên diễn đàn.
em có tham khảo mã trên diễn đàn về các tính tổng và tìm kiếm dữ liệu theo điều kiện và sử dụng bằng DIC nhưng do em không năm được VBA nên không biết chỉnh sửa lại cho phù hợp theo mong muốn của mình. nên em nhờ mọi người có thể giúp em sửa lại mã này với ạ.
Đề bài đặt ra là có 1 sheet dữ liệu chứa dữ liệu ban đầu. sheet thứ 2 sẽ nhập mã hàng và cỡ số sẽ tìm ra được số lượng của mã hàng và cỡ số đấy. nhưng nếu như cỡ số không được nhập gì thì em muốn nó tính tổng số lượng cho mã hàng đấy. khi nào điền cỡ số thì nó điền số lượng cụ thể của cỡ số đấy sau. em gửi file lên để mọi người dễ hình dung ạ!
em xin cảm ơn!
 

File đính kèm

  • Book1.xlsm
    20 KB · Đọc: 12
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
Pivot table nó ra đẹp và dễ hiểu hơn cái bnagr KQ của bạn nhiều. Mà khỏi phải cốt kiếc gì cả.

1626171758593.png
 

File đính kèm

  • 1626171580913.png
    1626171580913.png
    71.4 KB · Đọc: 4
Upvote 0
Upvote 0
theanhst92 đã viết:
dạ dữ liệu em làm là bảng tính trung gian chứ không phải bảng báo cáo. nên mong muốn sử dụng VBA để phục vụ nhu cầu tính toán tiếp theo. mong bác giúp đỡ ạ!
Nhấp chuột vào đây để mở rộng...
Loại cốt này ở đây nhiều người viết giỏi hơn tôi.

Ở bài #2 trên tôi chỉ nói cho những bạn khác biết "những gì có thể làm được từ công cụ có sẵn của Excel thì đừng nên dùng VBA"
 
Upvote 0
VetMini đã viết:
Loại cốt này ở đây nhiều người viết giỏi hơn tôi.

Ở bài #2 trên tôi chỉ nói cho những bạn khác biết "những gì có thể làm được từ công cụ có sẵn của Excel thì đừng nên dùng VBA"
Nhấp chuột vào đây để mở rộng...
dạ vâng, điều ấy em cũng đã tìm hiểu nhưng nó hiện tại chưa phù hợp với bài này của em ạ. bình thường khi lên báo cáo em vẫn thưởng sử dụng pivot để làm việc nhanh mà hiệu quả. mong được mọi người sửa bài giúp em.
 
Upvote 0

File đính kèm

  • Book1-cua Mr TheAnhst92.xlsm
    28 KB · Đọc: 10
Upvote 0
theanhst92 đã viết:
mong được mọi người sửa bài giúp em.
Nhấp chuột vào đây để mở rộng...
Bạn chạy thử Sub này:
PHP: 
Option Explicit

Sub TinhDL()
Dim sArr(), tArr(), KQ(), dArr(), MH As String, Txt As String
Dim i As Long, k As Long, R As Long, Rws As Long
Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DULIEU")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 3)
    For i = 1 To R
        MH = sArr(i, 1)
        If Not Dic.Exists(MH) Then
            k = k + 1
            Dic.Item(MH) = k
            tArr(k, 1) = MH
            tArr(k, 2) = sArr(i, 4)
            tArr(k, 3) = sArr(i, 5)
        Else
            Rws = Dic.Item(MH)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(i, 4)
            tArr(Rws, 3) = tArr(Rws, 3) + sArr(i, 5)
        End If
        Dic.Item(sArr(i, 1) & "#" & sArr(i, 3)) = i
    Next i
End With
With Sheets("KQ")
    KQ = .Range("A3", .Range("A100000").End(xlUp)).Resize(, 3).Value
    R = UBound(KQ)
    ReDim dArr(1 To R, 1 To 2)
    For i = 1 To R
        If KQ(i, 3) <> Empty Then
            Txt = KQ(i, 1) & "#" & KQ(i, 3)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                dArr(i, 1) = sArr(Rws, 4)
                dArr(i, 2) = sArr(Rws, 5)
            End If
        Else
            MH = KQ(i, 1)
            If Dic.Exists(MH) Then
                Rws = Dic.Item(MH)
                dArr(i, 1) = tArr(Rws, 2)
                dArr(i, 2) = tArr(Rws, 3)
            End If
        End If
    Next i
    .Range("D3:E3").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub
 
Upvote 0
HUONGHCKT đã viết:
Của bạn đây. Hy vọng là đúng ý. Hãy thử thay đổi dụ liệu cột C Sh KQ để thấy kết quả.

Toàn code chôm trên diễn đàn về chăp vá , xào xáo lại thôi mà.
Nhấp chuột vào đây để mở rộng...
Ba Tê đã viết:
Bạn chạy thử Sub này:
PHP: 
Option Explicit

Sub TinhDL()
Dim sArr(), tArr(), KQ(), dArr(), MH As String, Txt As String
Dim i As Long, k As Long, R As Long, Rws As Long
Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DULIEU")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 3)
    For i = 1 To R
        MH = sArr(i, 1)
        If Not Dic.Exists(MH) Then
            k = k + 1
            Dic.Item(MH) = k
            tArr(k, 1) = MH
            tArr(k, 2) = sArr(i, 4)
            tArr(k, 3) = sArr(i, 5)
        Else
            Rws = Dic.Item(MH)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(i, 4)
            tArr(Rws, 3) = tArr(Rws, 3) + sArr(i, 5)
        End If
        Dic.Item(sArr(i, 1) & "#" & sArr(i, 3)) = i
    Next i
End With
With Sheets("KQ")
    KQ = .Range("A3", .Range("A100000").End(xlUp)).Resize(, 3).Value
    R = UBound(KQ)
    ReDim dArr(1 To R, 1 To 2)
    For i = 1 To R
        If KQ(i, 3) <> Empty Then
            Txt = KQ(i, 1) & "#" & KQ(i, 3)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                dArr(i, 1) = sArr(Rws, 4)
                dArr(i, 2) = sArr(Rws, 5)
            End If
        Else
            MH = KQ(i, 1)
            If Dic.Exists(MH) Then
                Rws = Dic.Item(MH)
                dArr(i, 1) = tArr(Rws, 2)
                dArr(i, 2) = tArr(Rws, 3)
            End If
        End If
    Next i
    .Range("D3:E3").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ em xin cảm ơn tất cả mọi người đã giúp đỡ em ạ. tất cả đều phù hợp với điều em muốn rồi ạ. cảm ơn các anh chị rất nhiều!
 
Upvote 0
Ba Tê đã viết:
Bạn chạy thử Sub này:
PHP: 
Option Explicit

Sub TinhDL()
Dim sArr(), tArr(), KQ(), dArr(), MH As String, Txt As String
Dim i As Long, k As Long, R As Long, Rws As Long
Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DULIEU")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 5).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 3)
    For i = 1 To R
        MH = sArr(i, 1)
        If Not Dic.Exists(MH) Then
            k = k + 1
            Dic.Item(MH) = k
            tArr(k, 1) = MH
            tArr(k, 2) = sArr(i, 4)
            tArr(k, 3) = sArr(i, 5)
        Else
            Rws = Dic.Item(MH)
            tArr(Rws, 2) = tArr(Rws, 2) + sArr(i, 4)
            tArr(Rws, 3) = tArr(Rws, 3) + sArr(i, 5)
        End If
        Dic.Item(sArr(i, 1) & "#" & sArr(i, 3)) = i
    Next i
End With
With Sheets("KQ")
    KQ = .Range("A3", .Range("A100000").End(xlUp)).Resize(, 3).Value
    R = UBound(KQ)
    ReDim dArr(1 To R, 1 To 2)
    For i = 1 To R
        If KQ(i, 3) <> Empty Then
            Txt = KQ(i, 1) & "#" & KQ(i, 3)
            If Dic.Exists(Txt) Then
                Rws = Dic.Item(Txt)
                dArr(i, 1) = sArr(Rws, 4)
                dArr(i, 2) = sArr(Rws, 5)
            End If
        Else
            MH = KQ(i, 1)
            If Dic.Exists(MH) Then
                Rws = Dic.Item(MH)
                dArr(i, 1) = tArr(Rws, 2)
                dArr(i, 2) = tArr(Rws, 3)
            End If
        End If
    Next i
    .Range("D3:E3").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
em xin lỗi 1 chút ạ. em có gặp 1 chút vấn đề là khi dữ liệu đầu vào của em xuất hiện trùng cùng 1 mã và cùng 1 cỡ số thì nó lại không tính tổng số lượng của mã hàng và cỡ số đấy. mong bác sửa giúp ạ!
 
Upvote 0
theanhst92 đã viết:
em xin lỗi 1 chút ạ. em có gặp 1 chút vấn đề là khi dữ liệu đầu vào của em xuất hiện trùng cùng 1 mã và cùng 1 cỡ số thì nó lại không tính tổng số lượng của mã hàng và cỡ số đấy. mong bác sửa giúp ạ!
Nhấp chuột vào đây để mở rộng...
Thì bạn đưa cái file có dữ liệu "xin lỗi 1 chút" mọi người mới "tưởng tượng" ra được cách xử lý chứ.
Chẳng lẽ bạn buộc người khác phải giả lập dữ liệu "xin lỗi" theo ý tưởng của bạn luôn?
Mọi chuyện luôn dễ dàng khi mình tạo sự dễ dàng cho người khác.
 
Upvote 0
Ba Tê đã viết:
Thì bạn đưa cái file có dữ liệu "xin lỗi 1 chút" mọi người mới "tưởng tượng" ra được cách xử lý chứ.
Chẳng lẽ bạn buộc người khác phải giả lập dữ liệu "xin lỗi" theo ý tưởng của bạn luôn?
Mọi chuyện luôn dễ dàng khi mình tạo sự dễ dàng cho người khác.
Nhấp chuột vào đây để mở rộng...
Em xin gửi lại file! mong bác thông cảm giúp ạ!
 

File đính kèm

  • Book1.xlsm
    22.2 KB · Đọc: 6
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

V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
6
Đọc
80
Vệ Tư Lý
V
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
86
Nguyễn Linh hn94
N
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
3
Đọc
54
SA_DQ
SA_DQ
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
0
Đọc
16
batista911
B
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
134
zarra
zarra
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
6
Đọc
136
ptm0412
ptm0412
C
Chia sẻ: Kết quả xổ số Keno
    • Thích
Trả lời
2
Đọc
95
CHAOQUAY
C
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Thích
Trả lời
5
Đọc
275
anhdepjai
A
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
16
Đọc
332
CHAOQUAY
C
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
291
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
264
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
47
dung09031989
dung09031989
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
48
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
44
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
172
GPE-Trợ Lý
GPE-Trợ Lý
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
287
ptm0412
ptm0412
Mr Đạo
in giấy ra bị lệch xuống dưới
    • Thích
2
Trả lời
29
Đọc
26K
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