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

Liên hệ QC
K

Kool_Kool

Thành viên chính thức
Tham gia
12/6/15
Bài viết
83
Được thích
1
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
Nhấp chuột vào đây để mở rộng...
Bạn thử gửi file lên, hoặc tham khảo tại đây xem sao.
 
Upvote 0
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
 

File đính kèm

  • Daily_Report_1.xlsm
    1.8 MB · Đọc: 7
  • Bao Cao Tong Cua Tuan.xlsm
    188.2 KB · Đọc: 5
Upvote 0
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 ạ
Nhấp chuột vào đây để mở rộng...
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 đính kèm

  • BC_Ngay_K6-1.xlsm
    1.8 MB · Đọc: 9
  • Bao_Cao_Tong_Cua_Tuan.xlsm
    187.8 KB · Đọc: 9
Lần chỉnh sửa cuối:
Upvote 0
leevi đã viết:
Mình đính kèm FIle . Ban xem giúp mình nhé.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Cám ơn @HieuCD đã giúp.
Bài đã được tự động gộp:

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" ).
Nhấp chuột vào đây để mở rộng...
Cám ơn Hoàng Tuấn nhiều,
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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:

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" ).
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

  • Bao_Cao_Tong_Cua_Tuan.xlsm
    190.3 KB · Đọc: 5
  • BC_Ngay_K6-1.xlsm
    1.4 MB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
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:


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.
Nhấp chuột vào đây để mở rộng...
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)
 
Upvote 0
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)
Nhấp chuột vào đây để mở rộng...
À. 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
 

File đính kèm

  • Bao Cao Tong Cua Tuan.xlsm
    200.2 KB · Đọc: 5
  • BC_Ngay_K6-1.xlsm
    1.8 MB · Đọc: 4
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Cái này có dùng được ADO không anh nhỉ.
 
Upvote 0
Hoàng Tuấn 868 đã viết:
Bạn kiểm tra lại nhé.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
leevi đã viết:
Set sn = wbn.Sheets("Account" & k)
Nhấp chuột vào đây để mở rộng...
@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.
 
Upvote 0
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

phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
9
Đọc
211
Phan Thế Hiệp
Phan Thế Hiệp
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
16
Đọc
200
ptm0412
ptm0412
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
5
Đọc
107
VetMini
V
L
Các lấy công thức
Trả lời
5
Đọc
79
VetMini
V
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
17
Đọc
392
BuiQuangThuan
B
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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