Hàm sumif bằng VBA

Liên hệ QC
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

  • Hàm Sumifs.xlsm
    25.8 KB · Đọc: 7
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.
Web KT

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

keandanh141
Hướng dẫn hàm số tạo số ngẫu nhiên sao cho tổng bằng đúng 1 số
Trả lời
9
Đọc
145
CHAOQUAY
C
dunghtgiga
Tính bốn tuần cho một tháng
Trả lời
5
Đọc
98
Nhim5523
N
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
9 10 11
Trả lời
216
Đọc
12K
ongke0711
ongke0711
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.42 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
42
Đọc
21K
HeSanbi
HeSanbi
tamvie
Hướng dẫn dùng công cụ Goal Seek kết hợp với Macro để tính ra mức lương Gross
    • Thích
Trả lời
5
Đọc
2K
tranductruong90
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
10
Đọc
862
PhanTuHuong
PhanTuHuong
noisy
Nhờ hỗ trợ chuyển về chế độ xem thường trong excel
Trả lời
0
Đọc
30
noisy
noisy
thiensu
Giúp tôi lấy sheet name trong Excel
Trả lời
12
Đọc
13K
dactanhanglk
D
Tuấn Bụng Bự
DataBase (CSDL) nào cho lập trình VBA trong Excel ?
Trả lời
19
Đọc
553
Tuấn Bụng Bự
Tuấn Bụng Bự
L
Nhờ giúp công thức nhiều điều kiện ngày không liên tục
Trả lời
3
Đọc
103
huuthang_bd
huuthang_bd
T
File Excel bị đơ khi sửa số liệu
Trả lời
16
Đọc
184
vanle33
vanle33
N
Tính tổng giá trị hàng hóa của nhiều mặt hàng ( mỗi mặt hàng có 2 đến 3 giá )
2
Trả lời
34
Đọc
373
tranhungdao12a3
T
Hai Lúa Miền Tây
Nhập liệu, truy vấn dữ liệu qua Internet = VB.Net
    • Thích
2
Trả lời
32
Đọc
10K
nguyendang95
N
dllt2805
MẪU QUẢN LÝ CÔNG VIỆC ĐỘI NHÓM BẰNG EXCEL
Trả lời
10
Đọc
1K
dungluyen2119
dungluyen2119
B
Suy nghĩ của tui
    • Thích
2 3
Trả lời
58
Đọc
6K
SA_DQ
SA_DQ
thuyyeu99
  • Question
Kiểm tra file có tồn tại không
2
Trả lời
22
Đọc
13K
khonggianviet
K
Vũ trần bảo ngọc
Lỗi kết hợp hàm if và left
Trả lời
19
Đọc
267
HieuCD
H
T
Lỗi import dữ liệu
Trả lời
2
Đọc
164
hvnhpro
H
Quyen182
  • Question
Xin giúp code VBA để chèn ảnh có sẵn trong Excel vào phần comment
Trả lời
4
Đọc
274
Hoàng Tuấn 868
H
B
  • Question
Xin hướng dẫn tách 1 vùng dữ liệu sang thành nhiều sheet
Trả lời
4
Đọc
236
Bony_handsome
B
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