Hàm sumif bằng VBA (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
T

tranphuson

Thành viên thường trực
Tham gia
14/8/09
Bài viết
268
Được thích
10
Giới tính
Nam
Vui lòng hỗ trợ hàm Sumif bằng VBA file đính kèm.

Trong đây có 2 Sheet: Sheet 1 "Dữ liệu" và Sheet 2 "KQ": ở Sheet "KQ" thì dò tìm phòng ban và mã hàng theo Sheet "Dữ liệu" từ cột C đến cột G

Xin cảm ơn
 

File đính kèm

tranphuson đã viết:
Vui lòng hỗ trợ hàm Sumif bằng VBA file đính kèm.
Trong đây có 2 Sheet: Sheet 1 "Dữ liệu" và Sheet 2 "KQ": ở Sheet "KQ" thì dò tìm phòng ban và mã hàng theo Sheet "Dữ liệu" từ cột C đến cột G
Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Bài này của bạn đâu phải dùng sumif nhỉ.
 

File đính kèm

Cái này rõ ràng là Pivot Table chứ ai lại dùng công thức.

VBA chỉ là nhỏng nhẽo. Người ta biết đòi thì thế nào cũng có người viết giùm thôi.
 
tranphuson đã viết:
Vui lòng hỗ trợ hàm Sumif bằng VBA file đính kèm.

Trong đây có 2 Sheet: Sheet 1 "Dữ liệu" và Sheet 2 "KQ": ở Sheet "KQ" thì dò tìm phòng ban và mã hàng theo Sheet "Dữ liệu" từ cột C đến cột G

Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Bạn thử code siêu dở này xem:
Mã: 
Option Explicit

Sub Dung_Tin_Vao_Code_Cua_OT()

    Dim aMaHang() As Variant, aDulieu() As Variant
    Dim R As Long, I As Long, J As Long, Lr As Long
    
    With ThisWorkbook.Worksheets("Du lieu")
        Lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        aDulieu = .Range("B3:G" & Lr).Value2
    End With
    
    With ThisWorkbook.Worksheets("KQ")
        Lr = .Cells(.Rows.Count, "C").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu can tim": Exit Sub
        End If
        aMaHang = .Range("C4:E" & Lr).Value2
        For R = 1 To UBound(aMaHang, 1)
            For I = 1 To UBound(aDulieu, 1)
                For J = 1 To UBound(aDulieu, 2)
                    If aMaHang(R, 1) = aDulieu(I, 1) Then
                        If aMaHang(R, 2) = aDulieu(1, J) Then
                            aMaHang(R, 3) = aDulieu(I, J)
                        End If
                    End If
                Next J
            Next I
        Next R
        With .Range("G4").Resize(UBound(aMaHang, 1), UBound(aMaHang, 2))
            .ClearContents
            .Value = aMaHang
        End With
    End With
    
End Sub
 
NHN_Phương đã viết:
Bạn thử code siêu dở này xem:
Mã: 
Option Explicit

Sub Dung_Tin_Vao_Code_Cua_OT()

    Dim aMaHang() As Variant, aDulieu() As Variant
    Dim R As Long, I As Long, J As Long, Lr As Long
  
    With ThisWorkbook.Worksheets("Du lieu")
        Lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        aDulieu = .Range("B3:G" & Lr).Value2
    End With
  
    With ThisWorkbook.Worksheets("KQ")
        Lr = .Cells(.Rows.Count, "C").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu can tim": Exit Sub
        End If
        aMaHang = .Range("C4:E" & Lr).Value2
        For R = 1 To UBound(aMaHang, 1)
            For I = 1 To UBound(aDulieu, 1)
                For J = 1 To UBound(aDulieu, 2)
                    If aMaHang(R, 1) = aDulieu(I, 1) Then
                        If aMaHang(R, 2) = aDulieu(1, J) Then
                            aMaHang(R, 3) = aDulieu(I, J)
                        End If
                    End If
                Next J
            Next I
        Next R
        With .Range("G4").Resize(UBound(aMaHang, 1), UBound(aMaHang, 2))
            .ClearContents
            .Value = aMaHang
        End With
    End With
  
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn Chị, nhưng khi chạy VBA thì dữ liệu (double: nhân đôi) thêm từ Cột G đến Cột I. Nếu được thì mình cần anh hỗ trợ lấy dữ liệu như vậy nhưng không cần dữ liệu có sẵn cột B, C, D

1609760198957.png
Còn nếu xóa dữ liệu từ Cột B tới E thì báo
1609760239199.png
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Bạn thử code siêu dở này xem:
Mã: 
Option Explicit

Sub Dung_Tin_Vao_Code_Cua_OT()

    Dim aMaHang() As Variant, aDulieu() As Variant
    Dim R As Long, I As Long, J As Long, Lr As Long
   
    With ThisWorkbook.Worksheets("Du lieu")
        Lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        aDulieu = .Range("B3:G" & Lr).Value2
    End With
   
    With ThisWorkbook.Worksheets("KQ")
        Lr = .Cells(.Rows.Count, "C").End(xlUp).Row
        If Lr < 4 Then
            MsgBox "Khong co du lieu can tim": Exit Sub
        End If
        aMaHang = .Range("C4:E" & Lr).Value2
        For R = 1 To UBound(aMaHang, 1)
            For I = 1 To UBound(aDulieu, 1)
                For J = 1 To UBound(aDulieu, 2)
                    If aMaHang(R, 1) = aDulieu(I, 1) Then
                        If aMaHang(R, 2) = aDulieu(1, J) Then
                            aMaHang(R, 3) = aDulieu(I, J)
                        End If
                    End If
                Next J
            Next I
        Next R
        With .Range("G4").Resize(UBound(aMaHang, 1), UBound(aMaHang, 2))
            .ClearContents
            .Value = aMaHang
        End With
    End With
   
End Sub
Nhấp chuột vào đây để mở rộng...
Cô quân nhân code hay vậy mà bài của mình không quá khó mà lại không code được, kỳ à nha :D
 
tranphuson đã viết:
Cảm ơn Chị, nhưng khi chạy VBA thì dữ liệu (double: nhân đôi) thêm từ Cột G đến Cột I. Nếu được thì mình cần anh hỗ trợ lấy dữ liệu như vậy nhưng không cần dữ liệu có sẵn cột B, C, D

View attachment 252411
Còn nếu xóa dữ liệu từ Cột B tới E thì báo
View attachment 252412
Nhấp chuột vào đây để mở rộng...

Bấm mặt cười bạn nhé:
Mã: 
Option Explicit

Sub Dung_Tin_Vao_Code_Cua_OT()

    Dim aDULIEU() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long
    Dim DongCuoi As Long, CotCuoi As Long
    
    Const B_D_C_E As Integer = 4
    
    With ThisWorkbook.Worksheets("Du lieu")
        DongCuoi = .Cells(.Rows.Count, "B").End(xlUp).Row
        CotCuoi = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If DongCuoi < 4 Or CotCuoi < 3 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        DongCuoi = DongCuoi - 2:    CotCuoi = CotCuoi - 1
        aDULIEU = .Range("B3").Resize(DongCuoi, CotCuoi).Value2
        ReDim aKETQUA(1 To DongCuoi * CotCuoi, 1 To B_D_C_E)
    End With
    
    With ThisWorkbook.Worksheets("KQ")
        For jPhong = 2 To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aKETQUA(r, 1) = r
                aKETQUA(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 3) = aDULIEU(1, jPhong)
                aKETQUA(r, 4) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        DongCuoi = .Cells(.Rows.Count, "B").End(xlUp).Row
        If DongCuoi > 3 Then
            DongCuoi = DongCuoi - 3
            .Range("B4").Resize(DongCuoi, B_D_C_E).ClearContents
        End If
        .Range("B4").Resize(r, B_D_C_E) = aKETQUA
    End With
    
End Sub

Nhattanktnn đã viết:
Cô quân nhân code hay vậy mà bài của mình không quá khó mà lại không code được, kỳ à nha :D
Nhấp chuột vào đây để mở rộng...

Uầy hay thật á Bạn, Hic...OT cũng không hiểu có thể do yêu cầu của Sếp khiến cho OT mất hết tự tin ạ.
 

File đính kèm

NHN_Phương đã viết:
Bấm mặt cười bạn nhé:
Mã: 
Option Explicit

Sub Dung_Tin_Vao_Code_Cua_OT()

    Dim aDULIEU() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long
    Dim DongCuoi As Long, CotCuoi As Long
   
    Const B_D_C_E As Integer = 4
   
    With ThisWorkbook.Worksheets("Du lieu")
        DongCuoi = .Cells(.Rows.Count, "B").End(xlUp).Row
        CotCuoi = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If DongCuoi < 4 Or CotCuoi < 3 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        DongCuoi = DongCuoi - 2:    CotCuoi = CotCuoi - 1
        aDULIEU = .Range("B3").Resize(DongCuoi, CotCuoi).Value2
        ReDim aKETQUA(1 To DongCuoi * CotCuoi, 1 To B_D_C_E)
    End With
   
    With ThisWorkbook.Worksheets("KQ")
        For jPhong = 2 To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aKETQUA(r, 1) = r
                aKETQUA(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 3) = aDULIEU(1, jPhong)
                aKETQUA(r, 4) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        DongCuoi = .Cells(.Rows.Count, "B").End(xlUp).Row
        If DongCuoi > 3 Then
            DongCuoi = DongCuoi - 3
            .Range("B4").Resize(DongCuoi, B_D_C_E).ClearContents
        End If
        .Range("B4").Resize(r, B_D_C_E) = aKETQUA
    End With
   
End Sub



Uầy hay thật á Bạn, Hic...OT cũng không hiểu có thể do yêu cầu của Sếp khiến cho OT mất hết tự tin ạ.
Nhấp chuột vào đây để mở rộng...
Rất tốt cảm ơn bạn. Nhân tiện làm phiền bạn giúp thêm nếu Sheet "KQ" thêm 1 số dòng để nhập dữ liệu bằng tay. Do vậy Cột "Phòng ban và số lượng" sẽ dời qua Cột S và T. Cảm ơn

1609816882316.png
 

File đính kèm

  • 1609816600662.png
    1609816600662.png
    26.7 KB · Đọc: 2
tranphuson đã viết:
Rất tốt cảm ơn bạn. Nhân tiện làm phiền bạn giúp thêm nếu Sheet "KQ" thêm 1 số dòng để nhập dữ liệu bằng tay. Do vậy Cột "Phòng ban và số lượng" sẽ dời qua Cột S và T. Cảm ơn

View attachment 252437
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra nhé:
Code thêm một mảng 'aSaoLaiMaHang' (Phòng ban thường đi với mã nhân viên)
Bạn chú ý thêm câu lệnh này sẽ xóa cả dữ liệu nhập tay của bạn và dữ liệu do code thêm vào:
.Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
Nếu bạn muốn chỉ xóa dữ liệu do code thêm vào thì chỉnh lại dòng đó bạn nhé.

Mã: 
Sub Khong_Tot_Lam()

    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook
   
    Const O_Nhap_Lieu_Dau_Tien As String = "B4" 'Chỉnh sửa ô đầu tiên điền dữ liệu ở đây
    Const SoCotThemVao As Long = 15 'điền số cột thêm vào ở đây,ví dụ bạn thêm mới 15 cột (tính từ cột D đến cột R) thì điền 15
   
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1
        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With
   
    With Wb.Worksheets("KQ")
        For jPhong = 2 To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aSaoLaiMaHang(r, 1) = r
                aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 1) = aDULIEU(1, jPhong)
                aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With
   
End Sub
 
Lần chỉnh sửa cuối:
hongphuong1997 đã viết:
Quan trọng là học hỏi VBA thoi anh oi.
Còn làm thì thiếu gì cách?
Nhấp chuột vào đây để mở rộng...
Nếu nghĩ xa về tương lai thì học Pivot quan trọng hơn học code.
Pivot là công cụ của quản lý. Code là công cụ của cấp dưới hoặc của người muốn dùng VBA làm thú tiêu khiển.
 
NHN_Phương đã viết:
Bạn kiểm tra nhé:
Code thêm một mảng 'aSaoLaiMaHang' (Phòng ban thường đi với mã nhân viên)
Bạn chú ý thêm câu lệnh này sẽ xóa cả dữ liệu nhập tay của bạn và dữ liệu do code thêm vào:
.Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
Nếu bạn muốn chỉ xóa dữ liệu do code thêm vào thì chỉnh lại dòng đó bạn nhé.

Mã: 
Sub Khong_Tot_Lam()

    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook
  
    Const O_Nhap_Lieu_Dau_Tien As String = "B4" 'Chỉnh sửa ô đầu tiên điền dữ liệu ở đây
    Const SoCotThemVao As Long = 15 'điền số cột thêm vào ở đây,ví dụ bạn thêm mới 15 cột (tính từ cột D đến cột R) thì điền 15
  
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1
        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With
  
    With Wb.Worksheets("KQ")
        For jPhong = 2 To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aSaoLaiMaHang(r, 1) = r
                aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 1) = aDULIEU(1, jPhong)
                aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With
  
End Sub
Nhấp chuột vào đây để mở rộng...
Quá tuyệt, nhưng lần cuối làm phiền bạn là bên kế toán cần bổ sung thêm cột ở Sheet "Du lieu" thì chỉnh sửa như thế nào.

Xin lỗi đã làm phiền bạn chỉnh sửa nhiều lần. Cảm ơn sự hỗ trợ rất nhiệt tình này

1609842120810.png
 
tranphuson đã viết:
Quá tuyệt, nhưng lần cuối làm phiền bạn là bên kế toán cần bổ sung thêm cột ở Sheet "Du lieu" thì chỉnh sửa như thế nào.

Xin lỗi đã làm phiền bạn chỉnh sửa nhiều lần. Cảm ơn sự hỗ trợ rất nhiệt tình này

View attachment 252459
Nhấp chuột vào đây để mở rộng...

Híc mấy bữa nay ngủ OT toàn mơ về code không à, bạn chú ý sửa 2 dòng này nhé:
Const SoCotThemVao As Long = 15 'Số cột thêm sheet KQ
Const CotDuLieuThem As Long = 8 'Số cột thêm sheet Dữ liệu

Mã: 
Option Explicit

Sub Khong_Tot_Lam()

    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook
  
    Const O_Nhap_Lieu_Dau_Tien As String = "B4"
    Const SoCotThemVao As Long = 15'Số cột thêm sheet KQ
    Const CotDuLieuThem As Long = 8 'Số cột thêm sheet Dữ liệu
    
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 + CotDuLieuThem Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1

        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        SoCot = SoCot - (1 + CotDuLieuThem)
        SoDong = SoDong - 1
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With
  
    With Wb.Worksheets("KQ")
        SoCot = 2 + CotDuLieuThem
        For jPhong = SoCot To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aSaoLaiMaHang(r, 1) = r
                aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 1) = aDULIEU(1, jPhong)
                aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With
  
End Sub
 
NHN_Phương đã viết:
Híc mấy bữa nay ngủ OT toàn mơ về code không à, bạn chú ý sửa 2 dòng này nhé:
Const SoCotThemVao As Long = 15 'Số cột thêm sheet KQ
Const CotDuLieuThem As Long = 8 'Số cột thêm sheet Dữ liệu

Mã: 
Option Explicit

Sub Khong_Tot_Lam()

    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook

    Const O_Nhap_Lieu_Dau_Tien As String = "B4"
    Const SoCotThemVao As Long = 15'Số cột thêm sheet KQ
    Const CotDuLieuThem As Long = 8 'Số cột thêm sheet Dữ liệu
  
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 + CotDuLieuThem Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1

        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        SoCot = SoCot - (1 + CotDuLieuThem)
        SoDong = SoDong - 1
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With

    With Wb.Worksheets("KQ")
        SoCot = 2 + CotDuLieuThem
        For jPhong = SoCot To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                r = r + 1
                aSaoLaiMaHang(r, 1) = r
                aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                aKETQUA(r, 1) = aDULIEU(1, jPhong)
                aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With

End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã hỗ trợ rất nhiều.
 
tranphuson đã viết:
Quá tuyệt, nhưng lần cuối làm phiền bạn là bên kế toán cần bổ sung thêm cột ở Sheet "Du lieu" thì chỉnh sửa như thế nào.

Xin lỗi đã làm phiền bạn chỉnh sửa nhiều lần. Cảm ơn sự hỗ trợ rất nhiệt tình này

View attachment 252459
Nhấp chuột vào đây để mở rộng...
Bài nầy nên dùng công thức Excel :)
Thử code ;)
Mã: 
Sub ABC()
  Dim aMa(), aPhong(), aDuLieu(), Res(), Res2()
  Dim eRow&, i&, k&, j&, sRow&, sCol&, sRowRes&

  With Sheets("Du lieu")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 4 Then MsgBox "Khong co du lieu dau vao": Exit Sub
    aMa = .Range("B4:B" & eRow).Value
    aPhong = .Range("K3:O3").Value
    aDuLieu = .Range("K4:O" & eRow).Value
  End With
  sRow = UBound(aDuLieu): sCol = UBound(aDuLieu, 2)
  sRowRes = sRow * sCol
  ReDim Res(1 To sRowRes, 1 To 2)
  ReDim Res2(1 To sRowRes, 1 To 2)

  For j = 1 To sCol
    For i = 1 To sRow
      k = k + 1
      Res(k, 1) = k
      Res(k, 2) = aMa(i, 1)
      Res2(k, 1) = aPhong(1, j)
      Res2(k, 2) = aDuLieu(i, j)
    Next i
  Next j

  With Sheets("KQ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then
      .Range("B4:C" & eRow).ClearContents
      .Range("S4:T" & eRow).ClearContents
    End If
    .Range("B4").Resize(sRowRes, 2) = Res
    .Range("S4").Resize(sRowRes, 2) = Res2
  End With
End Sub
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Bài nầy nên dùng công thức Excel :)
Thử code ;)
Mã: 
Sub ABC()
  Dim aMa(), aPhong(), aDuLieu(), Res(), Res2()
  Dim eRow&, i&, k&, j&, sRow&, sCol&, sRowRes&

  With Sheets("Du lieu")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 4 Then MsgBox "Khong co du lieu dau vao": Exit Sub
    aMa = .Range("B4:B" & eRow).Value
    aPhong = .Range("K3:O3").Value
    aDuLieu = .Range("K4:O" & eRow).Value
  End With
  sRow = UBound(aDuLieu): sCol = UBound(aDuLieu, 2)
  sRowRes = sRow * sCol
  ReDim Res(1 To sRowRes, 1 To 2)
  ReDim Res2(1 To sRowRes, 1 To 2)

  For j = 1 To sCol
    For i = 1 To sRow
      k = k + 1
      Res(k, 1) = k
      Res(k, 2) = aMa(i, 1)
      Res2(k, 1) = aPhong(1, j)
      Res2(k, 2) = aDuLieu(i, j)
    Next i
  Next j

  With Sheets("KQ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then
      Range("B4:C" & eRow).ClearContents
      Range("S4:T" & eRow).ClearContents
    End If
    .Range("B4").Resize(sRowRes, 2) = Res
    .Range("S4").Resize(sRowRes, 2) = Res2
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Con chào Bác @HieuCD,
Hôm nay Bác lại có hứng thú vậy, tuyệt thật cảm ơn Bác đã tham gia trước đó con cứ mong mãi xem ai đó vào giúp con một tay để thế chỗ con :xmaslaugh:
Giả sử có nhiều Phòng Ban trùng nhau trong hàng ngang hoặc nhiều mã hàng trùng nhau trong cột dọc,những chỗ trùng đó muốn gộp lại thành 1.
Như vậy sẽ sử dụng Dic như thế nào vậy Bác, Bác chỉ dẫn thêm cho con cách dùng này với.
 
NHN_Phương đã viết:
Con chào Bác @HieuCD,
Hôm nay Bác lại có hứng thú vậy, tuyệt thật cảm ơn Bác đã tham gia trước đó con cứ mong mãi xem ai đó vào giúp con một tay để thế chỗ con :xmaslaugh:
Giả sử có nhiều Phòng Ban trùng nhau trong hàng ngang hoặc nhiều mã hàng trùng nhau trong cột dọc,những chỗ trùng đó muốn gộp lại thành 1.
Như vậy sẽ sử dụng Dic như thế nào vậy Bác, Bác chỉ dẫn thêm cho con cách dùng này với.
Nhấp chuột vào đây để mở rộng...
Dùng Dic.item(Mã hàng & Phòng)= thứ tự dòng kết quả, cuối cùng sort kết quả theo Phòng và Mã hàng
Bạn tự làm nha
 
NHN_Phương đã viết:
Dạ vâng, con cảm Bác đã chỉ dẫn. Con sẽ thử làm và thông lại ở đây khi con có điều kiện ạ :D
Nhấp chuột vào đây để mở rộng...

HieuCD đã viết:
Dùng Dic.item(Mã hàng & Phòng)= thứ tự dòng kết quả, cuối cùng sort kết quả theo Phòng và Mã hàng
Bạn tự làm nha
Nhấp chuột vào đây để mở rộng...
Bác ơi, bấm mặt cười nhé Bác: --=0

Mã: 
Option Explicit

Sub Tap_Voi_Dictionary()

    Dim Dic As New Scripting.Dictionary, sKey As String, iD As Long
    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook
    
    Const O_Nhap_Lieu_Dau_Tien As String = "B4"
    Const SoCotThemVao As Long = 15
    Const CotDuLieuThem As Long = 8
    
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 + CotDuLieuThem Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1
        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        SoCot = SoCot - (1 + CotDuLieuThem)
        SoDong = SoDong - 1
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With
  
    With Wb.Worksheets("KQ")
        SoCot = 2 + CotDuLieuThem
        For jPhong = SoCot To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                sKey = aDULIEU(iMa, 1) & "|" & aDULIEU(1, jPhong)
                If Not Dic.Exists(sKey) And sKey <> Empty Then
                    r = r + 1
                    Dic.Add sKey, r
                    aSaoLaiMaHang(r, 1) = r
                    aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                    aKETQUA(r, 1) = aDULIEU(1, jPhong)
                    aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
                Else
                    iD = Dic.Item(sKey)
                    aKETQUA(iD, 2) = aKETQUA(iD, 2) + aDULIEU(iMa, jPhong)
                End If
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With
  
End Sub

Ủa hình như không cần sort 2 điều kiện nữa Bác ạ, hic Bác góp ý thêm cho con ạ.
Con cảm ơn Bác @HieuCD
Bài đã được tự động gộp:

HieuCD đã viết:
Bài nầy nên dùng công thức Excel :)
Thử code ;)
Mã: 
Sub ABC()
  Dim aMa(), aPhong(), aDuLieu(), Res(), Res2()
  Dim eRow&, i&, k&, j&, sRow&, sCol&, sRowRes&

  With Sheets("Du lieu")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 4 Then MsgBox "Khong co du lieu dau vao": Exit Sub
    aMa = .Range("B4:B" & eRow).Value
    aPhong = .Range("K3:O3").Value
    aDuLieu = .Range("K4:O" & eRow).Value
  End With
  sRow = UBound(aDuLieu): sCol = UBound(aDuLieu, 2)
  sRowRes = sRow * sCol
  ReDim Res(1 To sRowRes, 1 To 2)
  ReDim Res2(1 To sRowRes, 1 To 2)

  For j = 1 To sCol
    For i = 1 To sRow
      k = k + 1
      Res(k, 1) = k
      Res(k, 2) = aMa(i, 1)
      Res2(k, 1) = aPhong(1, j)
      Res2(k, 2) = aDuLieu(i, j)
    Next i
  Next j

  With Sheets("KQ")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then
      Range("B4:C" & eRow).ClearContents
      Range("S4:T" & eRow).ClearContents
    End If
    .Range("B4").Resize(sRowRes, 2) = Res
    .Range("S4").Resize(sRowRes, 2) = Res2
  End With
End Sub
Nhấp chuột vào đây để mở rộng...

Bác ơi, Bác quên 2 dấu "." ở đầu kìa, bạn ấy mà chuyển cái mặt cười sang sheet khác là 'xong phim' :yahoo:
Mã: 
 If eRow > 3 Then
      Range("B4:C" & eRow).ClearContents
      Range("S4:T" & eRow).ClearContents
    End If
 

File đính kèm

Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Bác ơi, bấm mặt cười nhé Bác: --=0

Mã: 
Option Explicit

Sub Tap_Voi_Dictionary()

    Dim Dic As New Scripting.Dictionary, sKey As String, iD As Long
    Dim aDULIEU() As Variant, aSaoLaiMaHang() As Variant, aKETQUA() As Variant
    Dim iMa As Long, jPhong As Long, r As Long, SoDong As Long, SoCot As Long, Wb As Workbook
   
    Const O_Nhap_Lieu_Dau_Tien As String = "B4"
    Const SoCotThemVao As Long = 15
    Const CotDuLieuThem As Long = 8
   
    Set Wb = ThisWorkbook
    With Wb.Worksheets("Du lieu")
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        SoCot = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If SoDong < 4 Or SoCot < 3 + CotDuLieuThem Then
            MsgBox "Khong co du lieu dau vao": Exit Sub
        End If
        SoDong = SoDong - 2:    SoCot = SoCot - 1
        aDULIEU = .Range("B3").Resize(SoDong, SoCot).Value2
        SoCot = SoCot - (1 + CotDuLieuThem)
        SoDong = SoDong - 1
        ReDim aSaoLaiMaHang(1 To SoDong * SoCot, 1 To 2)
        ReDim aKETQUA(1 To SoDong * SoCot, 1 To 2)
    End With
 
    With Wb.Worksheets("KQ")
        SoCot = 2 + CotDuLieuThem
        For jPhong = SoCot To UBound(aDULIEU, 2)
            For iMa = 2 To UBound(aDULIEU, 1)
                sKey = aDULIEU(iMa, 1) & "|" & aDULIEU(1, jPhong)
                If Not Dic.Exists(sKey) And sKey <> Empty Then
                    r = r + 1
                    Dic.Add sKey, r
                    aSaoLaiMaHang(r, 1) = r
                    aSaoLaiMaHang(r, 2) = aDULIEU(iMa, 1)
                    aKETQUA(r, 1) = aDULIEU(1, jPhong)
                    aKETQUA(r, 2) = aDULIEU(iMa, jPhong)
                Else
                    iD = Dic.Item(sKey)
                    aKETQUA(iD, 2) = aKETQUA(iD, 2) + aDULIEU(iMa, jPhong)
                End If
            Next iMa
        Next jPhong
        SoDong = .Cells(.Rows.Count, "B").End(xlUp).Row
        If SoDong > 3 Then
            SoDong = SoDong - 3
            .Range(O_Nhap_Lieu_Dau_Tien).Resize(SoDong, SoCotThemVao + 4).ClearContents
        End If
        With .Range(O_Nhap_Lieu_Dau_Tien)
            .Resize(r, 2) = aSaoLaiMaHang
            .Offset(, SoCotThemVao + 2).Resize(r, 2) = aKETQUA
        End With
    End With
 
End Sub

Ủa hình như không cần sort 2 điều kiện nữa Bác ạ, hic Bác góp ý thêm cho con ạ.
Con cảm ơn Bác @HieuCD
Bài đã được tự động gộp:



Bác ơi, Bác quên 2 dấu "." ở đầu kìa, bạn ấy mà chuyển cái mặt cười sang sheet khác là 'xong phim' :yahoo:
Mã: 
 If eRow > 3 Then
      Range("B4:C" & eRow).ClearContents
      Range("S4:T" & eRow).ClearContents
    End If
Nhấp chuột vào đây để mở rộng...
Sort dữ liệu khi dữ liệu chưa xếp thứ tự, hoặc chỉ lấy những dòng có dữ liệu
 
HieuCD đã viết:
Sort dữ liệu khi dữ liệu chưa xếp thứ tự, hoặc chỉ lấy những dòng có dữ liệu
Nhấp chuột vào đây để mở rộng...
Con chào Bác,
Ha ha Bác đang ăn sáng đó ạ ahihi.
Dạ vâng, để sau con lại thử tiếp theo sự chỉ dẫn của Bác ạ.Hiện tại ở HN đang rất là lạnh, con xin phép đi nghỉ sớm đây ạ, con chúc Bác ngon miệng. :D
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

huytamlinh
Anh Chị giúp em sửa lỗi định dạng với ạ ! (3 người xem)
Trả lời
1
Đọc
13
dungpham01
D
S
Xin hỏi các pro. Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới). (2 người xem)
Trả lời
1
Đọc
32
Hoàng Tuấn 868
H
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (1 người xem)
    • Cười
Trả lời
10
Đọc
228
HUONGHCKT
H
T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp! (2 người xem)
Trả lời
1
Đọc
37
Hoàng Tuấn 868
H
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable (1 người xem)
Trả lời
0
Đọc
31
thuhacoicoi
T
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (5 người xem)
    • Thích
Trả lời
4
Đọc
888
nguyendang95
N
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
2
Đọc
67
Gà Công Nghệ
Gà Công Nghệ
V
Quản lý xuất nhập vật tư trong kho
Trả lời
19
Đọc
749
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên (1 người xem)
    • Cảm ơn
Trả lời
4
Đọc
338
phuongnam366377
phuongnam366377
F
Mấy cao thủ giúp dùm mình với. File excel bị lỗi mà mình không biết lỗi chỗ nào để sửa.
Trả lời
2
Đọc
99
firstbood
F
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
438
Đọc
58K
sát thủ uyên ương
S
X
Làm thế nào để ẩn "Blank" trong Pivot table
    • Thích
Trả lời
15
Đọc
36K
nguyenngochieu761321
nguyenngochieu761321
H
Đánh số thự theo lượt
Trả lời
5
Đọc
149
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL
Trả lời
2
Đọc
197
danhpheo
D
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show
Trả lời
2
Đọc
149
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ. (1 người xem)
Trả lời
5
Đọc
216
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
161
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
347
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
216
eagle12
E
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống (1 người xem)
Trả lời
1
Đọc
3K
aFdangthacmac
A
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom