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

quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
8
Đọc
929
thientac
T
A
[Cần Giúp] Excel nhiều người dùng cùng lúc
Trả lời
5
Đọc
105
hvnhpro
H
PhiTQ-ME
  • Question
Nhờ trợ giúp sửa VBA tính diễn giải khối lượng
Trả lời
9
Đọc
103
PhiTQ-ME
PhiTQ-ME
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
0
Đọc
20
tsslump
T
8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
2
Đọc
56
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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