Tìm số lượng theo nhiều điều kiện

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
anhkhang.ak1122

anhkhang.ak1122

Thành viên mới
Tham gia
24/5/23
Bài viết
26
Được thích
4
Em chào các bác. Em có sheet(TONG HOP) đang tổng hợp số lượng theo ngày của các màu. Do công việc yêu cầu phải chuyển sang dạng báo các khác như sheet(CHI TIET). Các bác xem giúp em với ạ. Nếu có code VBA thì càng tốt ạ. Em cảm ơn.
 

File đính kèm

anhkhang.ak1122 đã viết:
Em chào các bác. Em có sheet(TONG HOP) đang tổng hợp số lượng theo ngày của các màu. Do công việc yêu cầu phải chuyển sang dạng báo các khác như sheet(CHI TIET). Các bác xem giúp em với ạ. Nếu có code VBA thì càng tốt ạ. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bạn thử công thức

C5=INDEX('TONG HOP'!$C$5:$AN$5,,AGGREGATE(15,6,COLUMN('TONG HOP'!$A:$AL)/('TONG HOP'!$B$5:$B$6='CHI TIET'!$A5)/('TONG HOP'!$C$4:$AN$4='CHI TIET'!$B5)/(LOOKUP(COLUMN('TONG HOP'!$C$3:$AN$3),COLUMN('TONG HOP'!$C$3:$AN$3)/('TONG HOP'!$C$3:$AN$3<>""),'TONG HOP'!$C$3:$AN$3)=C$4),1))

Bạn xem file
 

File đính kèm

Nếu bạn cần vầy thì tham khảo macro kèm theo dưới đây:


MÀUNGÀY01/0202/0203/0204/0205/02. . .. . .15/0216/0217/0218/0219/02
BLUENHẬN82216066678276402244
BLUETRẢ65251454735653481149
BLUETỒN1713597165151174166177172

PHP: 
Sub ChiTiet()
 Dim Col As Integer, Cot As Integer, W As Integer, Nhan As Double, Tra As Double, Ton As Double

 With Sheets("Tong Hop")
    Col = .[B5].CurrentRegion.Columns.Count
    ReDim Arr(1 To 3, 1 To Col)
    For Cot = 3 To Col Step 2
        W = W + 1:                                  Nhan = .Cells(5, Cot).Value
        Arr(1, W) = Nhan:                           Tra = .Cells(5, Cot + 1).Value
        Arr(2, W) = Tra:                            Ton = Ton + Nhan - Tra
        Arr(3, W) = Ton
    Next Cot
 End With
 Sheets("Chi Tiet").[C5].Resize(3, W).Value = Arr()
End Sub
 
anhkhang.ak1122 đã viết:
Em chào các bác. Em có sheet(TONG HOP) đang tổng hợp số lượng theo ngày của các màu. Do công việc yêu cầu phải chuyển sang dạng báo các khác như sheet(CHI TIET). Các bác xem giúp em với ạ. Nếu có code VBA thì càng tốt ạ. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Thử với con macro dùng dictionary
PHP: 
Option Explicit
Option Compare Text
Sub GPE()
    Dim dic As Object, key, ton$
    Dim Lr&, Arr(), Lc&, i&, j&
    ton = "t" & ChrW(7891) & "n"
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("TONG HOP")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Lc = .Cells(4, Columns.Count).End(xlToLeft).Column
        Arr = .Range(.Cells(3, 2), .Cells(Lr, Lc)).Value
    End With
    For i = 3 To UBound(Arr, 1)
        For j = 2 To UBound(Arr, 2)
            If Arr(1, j) = "" Then Arr(1, j) = Arr(1, j - 1)
            key = Arr(i, 1) & "|" & Arr(1, j) & "|" & Arr(2, j)
            If Not dic.exists(key) Then dic.Add (key), Arr(i, j)
        Next j
    Next i
    With Sheets("CHI TIET")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Lc = .Cells(4, Columns.Count).End(xlToLeft).Column
        For i = 5 To Lr
            For j = 3 To Lc
            If .Cells(i, 2) <> ton Then
                key = .Cells(i, 1) & "|" & .Cells(4, j) & "|" & .Cells(i, 2)
                If dic.exists(key) Then
                    .Cells(i, j) = dic.Item(key)
                Else
                    .Cells(i, j) = ""
                End If
            End If
            Next j
        Next i
    End With
    MsgBox "Done"
    Set dic = Nothing
End Sub
 

File đính kèm

Tham khảo thêm cách khác coi sao
Mã: 
Option Explicit

Sub TongHop_anhkhangak1122()
    Dim Dic As Object, sArr(), Res(), i&, Key$, iR&, iC&, j&, x&, T
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("TONG HOP")
        iR = .Range("B" & Rows.Count).End(3).Row
        iC = .Cells(4, Columns.Count).End(1).Column
        sArr = .Range("B3").Resize(iR - 2, iC - 1).Value
    End With
    For i = 3 To UBound(sArr)
        For j = 2 To UBound(sArr, 2) Step 2
            For x = 0 To 1
                Key = sArr(i, 1) & "#" & sArr(1, j) & "#" & sArr(2, j + x)
                Dic(Key) = Dic(Key) + sArr(i, j + x)
            Next
        Next
    Next
    With Sheets("CHI TIET")
        iR = .Range("A" & Rows.Count).End(3).Row
        iC = .Cells(4, Columns.Count).End(1).Column
        .Range("C5").Resize(iR - 3, iC).ClearContents
        Res = .Range("A4").Resize(iR - 3, iC).Value
       
        For i = 2 To UBound(Res) Step 3
            For j = 3 To UBound(Res, 2)
                For x = 0 To 1
                    Key = Res(i + x, 1) & "#" & Res(1, j) & "#" & Res(i + x, 2)
                    If Dic.exists(Key) = True Then
                        Res(i + x, j) = Dic.Item(Key)
                    End If
                Next
                Res(i + 2, j) = Res(i, j) - Res(i + 1, j)
            Next
        Next
        .Range("A4").Resize(iR - 3, iC).Value = Res
    End With
End Sub
 
SA_DQ đã viết:
Nếu bạn cần vầy thì tham khảo macro kèm theo dưới đây:


MÀUNGÀY01/0202/0203/0204/0205/02. . .. . .15/0216/0217/0218/0219/02
BLUENHẬN82216066678276402244
BLUETRẢ65251454735653481149
BLUETỒN1713597165151174166177172

PHP: 
Sub ChiTiet()
 Dim Col As Integer, Cot As Integer, W As Integer, Nhan As Double, Tra As Double, Ton As Double

 With Sheets("Tong Hop")
    Col = .[B5].CurrentRegion.Columns.Count
    ReDim Arr(1 To 3, 1 To Col)
    For Cot = 3 To Col Step 2
        W = W + 1:                                  Nhan = .Cells(5, Cot).Value
        Arr(1, W) = Nhan:                           Tra = .Cells(5, Cot + 1).Value
        Arr(2, W) = Tra:                            Ton = Ton + Nhan - Tra
        Arr(3, W) = Ton
    Next Cot
 End With
 Sheets("Chi Tiet").[C5].Resize(3, W).Value = Arr()
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ cảm ơn bác ạ.
Bài đã được tự động gộp:

BuiQuangThuan đã viết:
Tham khảo thêm cách khác coi sao
Mã: 
Option Explicit

Sub TongHop_anhkhangak1122()
    Dim Dic As Object, sArr(), Res(), i&, Key$, iR&, iC&, j&, x&, T
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("TONG HOP")
        iR = .Range("B" & Rows.Count).End(3).Row
        iC = .Cells(4, Columns.Count).End(1).Column
        sArr = .Range("B3").Resize(iR - 2, iC - 1).Value
    End With
    For i = 3 To UBound(sArr)
        For j = 2 To UBound(sArr, 2) Step 2
            For x = 0 To 1
                Key = sArr(i, 1) & "#" & sArr(1, j) & "#" & sArr(2, j + x)
                Dic(Key) = Dic(Key) + sArr(i, j + x)
            Next
        Next
    Next
    With Sheets("CHI TIET")
        iR = .Range("A" & Rows.Count).End(3).Row
        iC = .Cells(4, Columns.Count).End(1).Column
        .Range("C5").Resize(iR - 3, iC).ClearContents
        Res = .Range("A4").Resize(iR - 3, iC).Value
      
        For i = 2 To UBound(Res) Step 3
            For j = 3 To UBound(Res, 2)
                For x = 0 To 1
                    Key = Res(i + x, 1) & "#" & Res(1, j) & "#" & Res(i + x, 2)
                    If Dic.exists(Key) = True Then
                        Res(i + x, j) = Dic.Item(Key)
                    End If
                Next
                Res(i + 2, j) = Res(i, j) - Res(i + 1, j)
            Next
        Next
        .Range("A4").Resize(iR - 3, iC).Value = Res
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhá. Nếu có thể bạn có thể bạn có thể sửa code bỏ qua dòng tính tống và những ô màu vàng được không ? Vì mình thỉnh thoảng cần sửa số lượng nhận và trả.
Bài đã được tự động gộp:

Thóc Sama đã viết:
Thử với con macro dùng dictionary
PHP: 
Option Explicit
Option Compare Text
Sub GPE()
    Dim dic As Object, key, ton$
    Dim Lr&, Arr(), Lc&, i&, j&
    ton = "t" & ChrW(7891) & "n"
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("TONG HOP")
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Lc = .Cells(4, Columns.Count).End(xlToLeft).Column
        Arr = .Range(.Cells(3, 2), .Cells(Lr, Lc)).Value
    End With
    For i = 3 To UBound(Arr, 1)
        For j = 2 To UBound(Arr, 2)
            If Arr(1, j) = "" Then Arr(1, j) = Arr(1, j - 1)
            key = Arr(i, 1) & "|" & Arr(1, j) & "|" & Arr(2, j)
            If Not dic.exists(key) Then dic.Add (key), Arr(i, j)
        Next j
    Next i
    With Sheets("CHI TIET")
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        Lc = .Cells(4, Columns.Count).End(xlToLeft).Column
        For i = 5 To Lr
            For j = 3 To Lc
            If .Cells(i, 2) <> ton Then
                key = .Cells(i, 1) & "|" & .Cells(4, j) & "|" & .Cells(i, 2)
                If dic.exists(key) Then
                    .Cells(i, j) = dic.Item(key)
                Else
                    .Cells(i, j) = ""
                End If
            End If
            Next j
        Next i
    End With
    MsgBox "Done"
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhé. Code của bạn đúng ý mình. Khi mình cho dữ liệu gốc vào nó hơi chậm ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Làm đại, bạn test thử nhé:

PHP: 
Option Explicit
Sub bebo021999()
Dim lr&, i&, j&, k&, c&, t&, m&
Dim rng, res(1 To 100000, 1 To 300), cell As Range
With Sheets("TONG HOP")
    rng = .Range("B5").CurrentRegion.Value
End With
c = 2: k = 1: res(1, 1) = "MAU": res(1, 2) = "NGAY"
For j = 3 To UBound(rng, 2) - 1 Step 2
    c = c + 1: res(1, c) = rng(1, j)
    Select Case c
        Case 3
            For i = 3 To UBound(rng)
                If Not IsEmpty(rng(i, 2)) Then
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "NHAN": res(k, c) = rng(i, j)
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "TRA": res(k, c) = rng(i, j + 1)
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "TON"
                End If
            Next
        Case Else
            For i = 3 To UBound(rng)
                If Not IsEmpty(rng(i, 2)) Then
                    m = 0
                    For t = 1 To k
                        If rng(i, 2) = res(t, 1) Then m = m + 1
                        Select Case m
                            Case 1
                                res(t, c) = rng(i, j)
                            Case 2
                                res(t, c) = rng(i, j + 1)
                        End Select
                    Next
                End If
            Next
    End Select
Next
Sheets("CHI TIET").Activate
Rows("4:1000").Delete
Range("A4").Resize(k, c).Value = res
With Range("A4").CurrentRegion
    For Each cell In .SpecialCells(xlCellTypeBlanks)
        cell.FormulaR1C1 = "=IFERROR(RC[-1]+0,0)+R[-2]C-R[-1]C   " '"=IF(COLUMN()=3,0,B7)+C5-C6"
    Next
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(lr, 1).Value = "TONG": Cells(lr, 2).Value = "NHAN"
Cells(lr, 1).Resize(3, 1).MergeCells = True
Cells(lr + 1, 2).Value = "TRA": Cells(lr + 2, 2).Value = "TON"
Range(Cells(lr, 3), Cells(lr + 2, c)).Formula = "=SUMIF($B$5:$B" & lr - 1 & ",$B26,C$5:C" & lr - 1 & ")"
Range(Cells(5, c + 1), Cells(lr + 2, c + 1)).FormulaR1C1 = "=sum(RC[" & -c + 2 & "]:RC[-1])"
Cells(4, c + 1).Value = "TONG"
With Range("A4").CurrentRegion
    .VerticalAlignment = xlCenter
    .Borders.LineStyle = xlContinuous
End With
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B5:B" & lr)
    If cell.Value = "TON" Then
        cell.Offset(0, -1).Value = ""
        cell.Resize(1, c).Interior.Color = vbYellow
    End If
Next
Range(Cells(4, c + 1), Cells(lr, c + 1)).Interior.Color = vbYellow
End Sub
 

File đính kèm

bebo021999 đã viết:
Làm đại, bạn test thử nhé:

PHP: 
Option Explicit
Sub bebo021999()
Dim lr&, i&, j&, k&, c&, t&, m&
Dim rng, res(1 To 100000, 1 To 300), cell As Range
With Sheets("TONG HOP")
    rng = .Range("B5").CurrentRegion.Value
End With
c = 2: k = 1: res(1, 1) = "MAU": res(1, 2) = "NGAY"
For j = 3 To UBound(rng, 2) - 1 Step 2
    c = c + 1: res(1, c) = rng(1, j)
    Select Case c
        Case 3
            For i = 3 To UBound(rng)
                If Not IsEmpty(rng(i, 2)) Then
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "NHAN": res(k, c) = rng(i, j)
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "TRA": res(k, c) = rng(i, j + 1)
                    k = k + 1: res(k, 1) = rng(i, 2): res(k, 2) = "TON"
                End If
            Next
        Case Else
            For i = 3 To UBound(rng)
                If Not IsEmpty(rng(i, 2)) Then
                    m = 0
                    For t = 1 To k
                        If rng(i, 2) = res(t, 1) Then m = m + 1
                        Select Case m
                            Case 1
                                res(t, c) = rng(i, j)
                            Case 2
                                res(t, c) = rng(i, j + 1)
                        End Select
                    Next
                End If
            Next
    End Select
Next
Sheets("CHI TIET").Activate
Rows("4:1000").Delete
Range("A4").Resize(k, c).Value = res
With Range("A4").CurrentRegion
    For Each cell In .SpecialCells(xlCellTypeBlanks)
        cell.FormulaR1C1 = "=IFERROR(RC[-1]+0,0)+R[-2]C-R[-1]C   " '"=IF(COLUMN()=3,0,B7)+C5-C6"
    Next
End With
lr = Cells(Rows.Count, "A").End(xlUp).Row + 1
Cells(lr, 1).Value = "TONG": Cells(lr, 2).Value = "NHAN"
Cells(lr, 1).Resize(3, 1).MergeCells = True
Cells(lr + 1, 2).Value = "TRA": Cells(lr + 2, 2).Value = "TON"
Range(Cells(lr, 3), Cells(lr + 2, c)).Formula = "=SUMIF($B$5:$B" & lr - 1 & ",$B26,C$5:C" & lr - 1 & ")"
Range(Cells(5, c + 1), Cells(lr + 2, c + 1)).FormulaR1C1 = "=sum(RC[" & -c + 2 & "]:RC[-1])"
Cells(4, c + 1).Value = "TONG"
With Range("A4").CurrentRegion
    .VerticalAlignment = xlCenter
    .Borders.LineStyle = xlContinuous
End With
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B5:B" & lr)
    If cell.Value = "TON" Then
        cell.Offset(0, -1).Value = ""
        cell.Resize(1, c).Interior.Color = vbYellow
    End If
Next
Range(Cells(4, c + 1), Cells(lr, c + 1)).Interior.Color = vbYellow
End Sub
Nhấp chuột vào đây để mở rộng...
Em nhìn qua code của bác bebo021999 thấy đã khủng rồi. Bác lại cho chạy luôn cả Màu và Ngày tháng giúp em nữa, tô màu Tồn nữa chứ. Cảm ơn bác rất rất nhiều.
 
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

zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
13
Đọc
332
ongke0711
ongke0711
ERX_Vietnam
Xuống dòng trong chuỗi ký tự
Trả lời
13
Đọc
16K
anhtam9zz
A
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
27
Đọc
10K
mrdam199x
mrdam199x
chaungo898
Lỗi khi sử dụng Excel Mong các a giúp đỡ
Trả lời
12
Đọc
218
HeSanbi
HeSanbi
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
7
Đọc
1K
dihoathienvu
D
H
[xin trợ giúp] Tạo tra cứu dữ liệu hàng ngang thành hàng dọc
Trả lời
4
Đọc
110
hoangfe3o4
H
meomap1904
CÁCH VIẾT HÀM KHI Ô DỮ LIỆU BỊ MERGE
Trả lời
7
Đọc
99
Duy Tùng 9x
Duy Tùng 9x
minhminh040499
Filter không hoạt động.
    • Cười
Trả lời
3
Đọc
77
BuiQuangThuan
B
Nami_kc
Không copy paste nội dung giữa các sheet và file excel được
Trả lời
1
Đọc
33
phansythao
phansythao
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL KẾT HỢP VỚI GOOGLE SHEETS ỨNG DỤNG THỰC TẾ
    • Thích
Trả lời
6
Đọc
2K
kiendt1973
K
D
Auto refresh sheet
Trả lời
10
Đọc
3K
VetMini
V
B
Excel tự đẻ thêm ra file đuôi 000
Trả lời
0
Đọc
39
bmtuanltpt
B
L
Nhờ sửa lỗi Hàm If
Trả lời
4
Đọc
122
linhhongphucloc
L
NguyenthiH
Sao dùng Ctl + H thay thế không đúng.
Trả lời
17
Đọc
167
HeSanbi
HeSanbi
ptlong04x1
Làm mất đường đứt nét khi chuyển từ Page Break Preview --> Normal.
Trả lời
10
Đọc
66K
huhumalu
H
H
Thảo luận: Nguyên tắc xác định đơn giá đất ở
    • Thích
Trả lời
1
Đọc
147
PhanTuHuong
PhanTuHuong
NguyenthiH
Tạo Barcode trong Excel để khi quét thì hiện: Tên vật tư,tồn đầu, nhập, xuất, tồn cuối.
Trả lời
2
Đọc
107
NguyenthiH
NguyenthiH
N
  • Question Question
Xin giúp đỡ Code VBA không chạy.
    • Cười
Trả lời
8
Đọc
185
HeSanbi
HeSanbi
N
  • Question Question
[Help] Tổng hợp dữ liệu từ nhiều file excel vào 1 file
Trả lời
2
Đọc
98
DeTong
D
giaiphap
Chia sẻ cách tạo gợi ý cho hàm trong Excel bằng thư viện ExcelDna.
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
15
Đọc
2K
kampria_328
K
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.
Back
Top Bottom