Nhờ Các Bạn Diễn Đàn Giúp Code VBA Sumif từ một workbook khác.

Kool_Kool · 24/1/21

Chào Anh Chi và các bạn, Nhờ giúp Code VBA . Mình cần thực hiện lấy dự liệu sumif ở nhiều sheets ( Các sheet co mẫu giống nhau) trong một File Excel khác. Mình đang thực hiện Record Marcro thì code quá dài VBA không chấp nhận. Nhờ Anh Chị hướng dẫn code khác . Hoặc hướng dẫn mình rút gọn bớt code sau . Minh thực hiện sumif gần 70 sheets nên recode rất nhiều dòng. Cám ơn diễn đàn

Option Explicit

Sub Get_Data_From_File_006_Update1()

Dim FileToOpen As Variant

Dim OpenBook As Workbook

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)

ThisWorkbook.Activate

Sheets("Report_007).Select

Range("G13").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C5)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G14").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C6)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G15").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C7),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G32").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C8),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G48").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C9)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G49").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C10)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G55").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C11),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G56").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C12),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G57").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C13),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G58").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]1_HERSCHEL'!C14),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J13").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C5)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J14").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C6)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J15").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C7),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J32").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C8),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J48").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C9)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J49").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C10)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J55").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C11),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J56").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C12),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J57").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C13),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("J58").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]2_HERSCHEL_OB_PnP'!C14),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M13").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C5)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M14").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C6)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M15").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C7),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M32").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C8),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M48").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C9)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M49").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C10)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M55").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C11),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M56").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C12),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M57").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C13),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("M58").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]3_EI_KNQ_CRAYOLA'!C14),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P13").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C5)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P14").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C6)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P15").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C7),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P32").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C8),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P48").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C9)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P49").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C10)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P55").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C11),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P56").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C12),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P57").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C13),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("P58").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]4_SCI_EI'!C14),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S13").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C5)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S14").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C6)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S15").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C7),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S32").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C8),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S48").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C9)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S49").Select

ActiveCell.FormulaR1C1 = _

=SUMIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C10)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S55").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C11),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S56").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C12),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("S57").Select

ActiveCell.FormulaR1C1 = _

=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]5_BOAD&MORE'!C13),0)

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

OpenBook.Close False

End If

Application.ScreenUpdating = True

MsgBox "Done Update !"

Range("A5").Select

End Sub

Hoàng Tuấn 868 · 24/1/21

leevi đã viết:
Chào Anh Chi và các bạn, Nhờ giúp Code VBA . Mình cần thực hiện lấy dự liệu sumif ở nhiều sheets ( Các sheet co mẫu giống nhau) trong một File Excel khác. Mình đang thực hiện Record Marcro thì code quá dài VBA không chấp nhận. Nhờ Anh Chị hướng dẫn code khác . Hoặc hướng dẫn mình rút gọn bớt code sau . Minh thực hiện sumif gần 70 sheets nên recode rất nhiều dòng. Cám ơn diễn đàn

Bạn thử gửi file lên, hoặc tham khảo tại đây xem sao.

Kool_Kool · 24/1/21

Mình cần lấy dữ liệu tổng của tuần từ báo cáo ngày của từng khách. Vui lòng giúp đỡ
Hiện tại mình phải sử dụng công thức cho từng ô và copy bỏ vào VBA.

Range("G13").Select

ActiveCell.FormulaR1C1 = _

"=SUMIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C5)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G14").Select

ActiveCell.FormulaR1C1 = _

"=SUMIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C6)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G15").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R[-14]C[-3],'[BC_Ngay_K6-1.xlsm]Account1'!C7),0)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G32").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C8),0)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G48").Select

ActiveCell.FormulaR1C1 = _

"=SUMIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C9)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G49").Select

ActiveCell.FormulaR1C1 = _

"=SUMIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C10)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G55").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C11),0)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G56").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C12),0)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Range("G57").Select

ActiveCell.FormulaR1C1 = _

"=IFERROR(AVERAGEIF('[BC_Ngay_K6-1.xlsm]Account1'!C2,R1C4,'[BC_Ngay_K6-1.xlsm]Account1'!C13),0)"

ActiveCell.Copy

Selection.PasteSpecial xlPasteValues

Kool_Kool · 24/1/21

Hoàng Tuấn 868 đã viết:
Bạn thử gửi file lên, hoặc tham khảo tại đây xem sao.

Mình đính kèm FIle . Ban xem giúp mình nhé.

Hoàng Tuấn 868 · 24/1/21

leevi đã viết:
Mình đính kèm FIle . Ban xem giúp mình nhé.

Sao bạn không để sheet tổng hợp chung vào file theo dõi ngày cho tiện nhỉ?

Kool_Kool · 24/1/21

Hoàng Tuấn 868 đã viết:
Sao bạn không để sheet tổng hợp chung vào file theo dõi ngày cho tiện nhỉ?

À. 2 File có mục đích sử dụng cho nhiều người. Vi vậy không để chung được. Phải dùng cách thức update Vu ạ

Hoàng Tuấn 868 · 25/1/21

leevi đã viết:
À. 2 File có mục đích sử dụng cho nhiều người. Vi vậy không để chung được. Phải dùng cách thức update Vu ạ

Bạn xem thử nhé. (Bạn lưu hai file cùng thư mục, đặt tên thư mục là TH lưu tại ổ D. Nếu lưu thư mục khác thì bạn chỉnh lại đường dẫn trong code cho phù hợp.: "D:\TH\BC_Ngay_K6-1.xlsm" ).

HieuCD · 25/1/21

leevi đã viết:
Mình đính kèm FIle . Ban xem giúp mình nhé.

Thử code

Mã:

Sub ABC()
  Dim wB As Workbook, shMain As Worksheet, sh As Worksheet
  Dim i&, j&, r&, sRow&, sCol&
  Dim Res(), sArr(), tuan&, FileToOpen
 
  On Error Resume Next
  Set shMain = ThisWorkbook.Sheets("Repot_Week_WH7")
  tuan = shMain.Range("D1").Value
  If tuan < 1 Or tuan > 53 Then MsgBox ("Du lieu tuan sai!"): Exit Sub
  Res = shMain.Range("C13:GX15").Value
  sCol = UBound(Res, 2)
  For j = 2 To sCol Step 3
    For r = 1 To 3
      Res(r, j) = Empty
    Next r
  Next j
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  'FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
  'If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
  'Set wB = Application.Workbooks.Open(FileToOpen)
  Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren

  For j = 5 To sCol Step 3
    Set sh = wB.Sheets("Account" & Int(j / 3))
    If Err.Number = 0 Then
      sArr = sh.Range("B3:G" & sh.Range("B" & Rows.Count).End(xlUp).Row).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        If sArr(i, 1) = tuan Then
          For r = 1 To 3
            Res(r, j) = Res(r, j) + sArr(i, 3 + r)
            Res(r, 2) = Res(r, 2) + sArr(i, 3 + r)
          Next r
        ElseIf sArr(i, 1) > tuan Then
          Exit For
        End If
      Next i
    Else
      Err.Number = 0
    End If
  Next j
  wB.Close False
 
  shMain.Range("C13:GX15") = Res
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Kool_Kool · 25/1/21

HieuCD đã viết:

Thử code

Mã:

Sub ABC()
  Dim wB As Workbook, shMain As Worksheet, sh As Worksheet
  Dim i&, j&, r&, sRow&, sCol&
  Dim Res(), sArr(), tuan&, FileToOpen

  On Error Resume Next
  Set shMain = ThisWorkbook.Sheets("Repot_Week_WH7")
  tuan = shMain.Range("D1").Value
  If tuan < 1 Or tuan > 53 Then MsgBox ("Du lieu tuan sai!"): Exit Sub
  Res = shMain.Range("C13:GX15").Value
  sCol = UBound(Res, 2)
  For j = 2 To sCol Step 3
    For r = 1 To 3
      Res(r, j) = Empty
    Next r
  Next j

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  'FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
  'If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
  'Set wB = Application.Workbooks.Open(FileToOpen)
  Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren

  For j = 5 To sCol Step 3
    Set sh = wB.Sheets("Account" & Int(j / 3))
    If Err.Number = 0 Then
      sArr = sh.Range("B3:G" & sh.Range("B" & Rows.Count).End(xlUp).Row).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        If sArr(i, 1) = tuan Then
          For r = 1 To 3
            Res(r, j) = Res(r, j) + sArr(i, 3 + r)
            Res(r, 2) = Res(r, 2) + sArr(i, 3 + r)
          Next r
        ElseIf sArr(i, 1) > tuan Then
          Exit For
        End If
      Next i
    Else
      Err.Number = 0
    End If
  Next j
  wB.Close False

  shMain.Range("C13:GX15") = Res
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Cám ơn @HieuCD đã giúp.

Bài đã được tự động gộp: 25/1/21

Hoàng Tuấn 868 đã viết:
Bạn xem thử nhé. (Bạn lưu hai file cùng thư mục, đặt tên thư mục là TH lưu tại ổ D. Nếu lưu thư mục khác thì bạn chỉnh lại đường dẫn trong code cho phù hợp.: "D:\TH\BC_Ngay_K6-1.xlsm" ).

Cám ơn Hoàng Tuấn nhiều,

Kool_Kool · 25/1/21

HieuCD đã viết:

Thử code

Mã:

Sub ABC()
  Dim wB As Workbook, shMain As Worksheet, sh As Worksheet
  Dim i&, j&, r&, sRow&, sCol&
  Dim Res(), sArr(), tuan&, FileToOpen

  On Error Resume Next
  Set shMain = ThisWorkbook.Sheets("Repot_Week_WH7")
  tuan = shMain.Range("D1").Value
  If tuan < 1 Or tuan > 53 Then MsgBox ("Du lieu tuan sai!"): Exit Sub
  Res = shMain.Range("C13:GX15").Value
  sCol = UBound(Res, 2)
  For j = 2 To sCol Step 3
    For r = 1 To 3
      Res(r, j) = Empty
    Next r
  Next j

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  'FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
  'If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
  'Set wB = Application.Workbooks.Open(FileToOpen)
  Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren

  For j = 5 To sCol Step 3
    Set sh = wB.Sheets("Account" & Int(j / 3))
    If Err.Number = 0 Then
      sArr = sh.Range("B3:G" & sh.Range("B" & Rows.Count).End(xlUp).Row).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        If sArr(i, 1) = tuan Then
          For r = 1 To 3
            Res(r, j) = Res(r, j) + sArr(i, 3 + r)
            Res(r, 2) = Res(r, 2) + sArr(i, 3 + r)
          Next r
        ElseIf sArr(i, 1) > tuan Then
          Exit For
        End If
      Next i
    Else
      Err.Number = 0
    End If
  Next j
  wB.Close False

  shMain.Range("C13:GX15") = Res
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Mình chạy nó báo không tìm thấy dữ liệu. Cho mình giúp mình File ạ

Bài đã được tự động gộp: 25/1/21

Hoàng Tuấn 868 đã viết:
Bạn xem thử nhé. (Bạn lưu hai file cùng thư mục, đặt tên thư mục là TH lưu tại ổ D. Nếu lưu thư mục khác thì bạn chỉnh lại đường dẫn trong code cho phù hợp.: "D:\TH\BC_Ngay_K6-1.xlsm" ).

File mình chạy tốt rồi. Tuy nhiên mình cần tính trung bình cho dòng thứ 3. và các dòng còn lại tính tổng. Nhờ Hoàng Tuấn giúp mình thêm.

HieuCD · 25/1/21

leevi đã viết:
Mình chạy nó báo không tìm thấy dữ liệu. Cho mình giúp mình File ạ

Bài đã được tự động gộp: 25/1/21

File mình chạy tốt rồi. Tuy nhiên mình cần tính trung bình cho dòng thứ 3. và các dòng còn lại tính tổng. Nhờ Hoàng Tuấn giúp mình thêm.

Thay dòng lệnh
Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren
bằng
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
Set wB = Application.Workbooks.Open(FileToOpen)

Kool_Kool · 25/1/21

HieuCD đã viết:
Thay dòng lệnh
Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren
bằng
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
Set wB = Application.Workbooks.Open(FileToOpen)

À. Mình thay bằng dòng lệnh này rồi @HieuCD ạ. Tuy nhiên dữ liệu cập nhập trống. Xem giúp mình

HieuCD · 26/1/21

leevi đã viết:
À. Mình thay bằng dòng lệnh này rồi @HieuCD ạ. Tuy nhiên dữ liệu cập nhập trống. Xem giúp mình

Bạn gõ nhầm tên sheet, chỉnh lại
Set shMain = ThisWorkbook.Sheets("Report_Week_WH7")

Hoàng Tuấn 868 · 26/1/21

leevi đã viết:
File mình chạy tốt rồi. Tuy nhiên mình cần tính trung bình cho dòng thứ 3. và các dòng còn lại tính tổng.

Bạn kiểm tra lại nhé.

snow25 · 26/1/21

HieuCD đã viết:

Thử code

Mã:

Sub ABC()
  Dim wB As Workbook, shMain As Worksheet, sh As Worksheet
  Dim i&, j&, r&, sRow&, sCol&
  Dim Res(), sArr(), tuan&, FileToOpen

  On Error Resume Next
  Set shMain = ThisWorkbook.Sheets("Repot_Week_WH7")
  tuan = shMain.Range("D1").Value
  If tuan < 1 Or tuan > 53 Then MsgBox ("Du lieu tuan sai!"): Exit Sub
  Res = shMain.Range("C13:GX15").Value
  sCol = UBound(Res, 2)
  For j = 2 To sCol Step 3
    For r = 1 To 3
      Res(r, j) = Empty
    Next r
  Next j

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  'FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
  'If FileToOpen = False Then MsgBox ("Chua chon File Du Lieu"): Exit Sub
  'Set wB = Application.Workbooks.Open(FileToOpen)
  Set wB = Workbooks.Open(ThisWorkbook.Path & "\BC_Ngay_K6-1.xlsm") 'Thay dong lenh nay bang 3 dong lenh tren

  For j = 5 To sCol Step 3
    Set sh = wB.Sheets("Account" & Int(j / 3))
    If Err.Number = 0 Then
      sArr = sh.Range("B3:G" & sh.Range("B" & Rows.Count).End(xlUp).Row).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        If sArr(i, 1) = tuan Then
          For r = 1 To 3
            Res(r, j) = Res(r, j) + sArr(i, 3 + r)
            Res(r, 2) = Res(r, 2) + sArr(i, 3 + r)
          Next r
        ElseIf sArr(i, 1) > tuan Then
          Exit For
        End If
      Next i
    Else
      Err.Number = 0
    End If
  Next j
  wB.Close False

  shMain.Range("C13:GX15") = Res
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Cái này có dùng được ADO không anh nhỉ.

HieuCD · 26/1/21

snow25 đã viết:
Cái này có dùng được ADO không anh nhỉ.

Cấu trúc 3 sheet giống nhau, dùng ADO sẽ gọn hơn nhiều, bạn viết thử nha

Kool_Kool · 27/1/21

Hoàng Tuấn 868 đã viết:
Bạn kiểm tra lại nhé.

Cám ơn @Hoàng Tuấn 868 . md(20, 6 + j) = md(20, 6 + j) + mn(i, 7) chổ số giờ OT mình cần tính trung bình. Nhờ Hoàng Tuấn chỉnh giúp mình 1 tí nữa ạ.

Option Explicit

Sub tong_hop1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbn As Workbook, wbd As Workbook
Dim sn As Worksheet, sd As Worksheet
Dim i As Long, j As Long, k As Long, n As Long, Lrn As Long, cotcuoi As Long
Dim mn(), md()

On Error Resume Next
Set wbd = ThisWorkbook
Set sd = wbd.Sheets("Repot_Week_WH7")
cotcuoi = sd.Cells(4, sd.Columns.Count).End(xlToLeft).Column

With sd
For j = 1 To cotcuoi Step 3
.Cells(13, 6 + j).ClearContents: .Cells(49, 6 + j).ClearContents
.Cells(14, 6 + j).ClearContents: .Cells(55, 6 + j).ClearContents
.Cells(15, 6 + j).ClearContents: .Cells(56, 6 + j).ClearContents
.Cells(32, 6 + j).ClearContents: .Cells(57, 6 + j).ClearContents
.Cells(48, 6 + j).ClearContents: .Cells(58, 6 + j).ClearContents
Next
End With

md = sd.Range("B13:GX58")
j = 0
Set wbn = Workbooks.Open("D:\TH\BC_Ngay_K6-1.xlsm")
For k = 1 To wbn.Sheets.Count - 1
Set sn = wbn.Sheets("Account" & k)
Lrn = sn.Cells(Rows.Count, 2).End(xlUp).Row
mn = sn.Range("B3:N" & Lrn)
n = 0
For i = 1 To UBound(mn, 1)
If mn(i, 1) = sd.Range("D1") Then
n = n + 1
md(1, 6 + j) = md(1, 6 + j) + mn(i, 4): md(37, 6 + j) = md(37, 6 + j) + mn(i, 9)
md(2, 6 + j) = md(2, 6 + j) + mn(i, 5): md(43, 6 + j) = md(43, 6 + j) + mn(i, 10)
md(3, 6 + j) = md(3, 6 + j) + mn(i, 6): md(44, 6 + j) = md(44, 6 + j) + mn(i, 11)
md(20, 6 + j) = md(20, 6 + j) + mn(i, 7): md(45, 6 + j) = md(45, 6 + j) + mn(i, 12)
md(36, 6 + j) = md(36, 6 + j) + mn(i, 8): md(46, 6 + j) = md(46, 6 + j) + mn(i, 13)

ElseIf sd.Range("D1") > 52 Or sd.Range("D1") < 1 Or sd.Range("D1") = "-" Then
Exit For
End If
Next
md(3, 6 + j) = md(3, 6 + j) / n 'Ton
md(43, 6 + j) = md(43, 6 + j) / n / 100 'Nhap
md(44, 6 + j) = md(44, 6 + j) / n / 100 'Xuat
md(45, 6 + j) = md(45, 6 + j) / n / 100 'Cho
md(46, 6 + j) = md(46, 6 + j) / n / 100 'inventory
j = j + 3
Next

sd.Range("B13:GX58") = md
wbn.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hoàng Tuấn 868 · 27/1/21

leevi đã viết:
Chỗ số giờ OT mình cần tính trung bình. Nhờ Hoàng Tuấn chỉnh giúp mình 1 tí nữa ạ.

Bạn xem được chưa nhé.

Kool_Kool · 27/1/21

Hoàng Tuấn 868 đã viết:
Bạn xem được chưa nhé.

Chạy tốt rồi. Cám ơn Hoàng Tuấn nhiều.

Kool_Kool · 27/1/21

leevi đã viết:
Set sn = wbn.Sheets("Account" & k)

@Hoàng Tuấn 868 ơi. Để chuẩn chỉnh hơn , Để người dùng dễ nhận biết tên khách hàng. Mình cần thêm 1 đuôi tên khách hàng vào tên sheet (Ví dụ Account1 Mình sẽ thêm Account001_Tên khách A...). TRường hợp này mình sẽ cố định 10 ký tự đâu tiên để dò tìm. Còn lại mình có thể thay đôi. Có cách nào nhờ Tuấn giúp thêm.

Nhờ Các Bạn Diễn Đàn Giúp Code VBA Sumif từ một workbook khác.

Thành viên chính thức

Đăng ký hôm qua

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Đăng ký hôm qua

Thành viên chính thức

Đăng ký hôm qua

File đính kèm

Chuyên gia GPE

Thành viên chính thức

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Đăng ký hôm qua

File đính kèm

Thành viên gạo cội

Chuyên gia GPE

Thành viên chính thức

Đăng ký hôm qua

File đính kèm

Thành viên chính thức

Thành viên chính thức