Chào Anh Chị và các bạn diễn đàn,
Với File hiện tại. Sau khi cập nhập được dữ liệu toàn bộ dữ liệu đã chuyển sang dạng giá trị. Một số ô mình thiết lập công thức cũng chuyển sang giá trị. Nhờ Anh Chị và các bạn diễn đàn chỉnh sửa giúp để các ô không liên quan vẫn giữ nguyên công thức. Xin cám ơn.
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 = Sheets.Count - 1 To 1 Step -1
Set sn = wbn.Sheets(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(20, 6 + j) = md(20, 6 + j) / n
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
Với File hiện tại. Sau khi cập nhập được dữ liệu toàn bộ dữ liệu đã chuyển sang dạng giá trị. Một số ô mình thiết lập công thức cũng chuyển sang giá trị. Nhờ Anh Chị và các bạn diễn đàn chỉnh sửa giúp để các ô không liên quan vẫn giữ nguyên công thức. Xin cám ơn.
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 = Sheets.Count - 1 To 1 Step -1
Set sn = wbn.Sheets(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(20, 6 + j) = md(20, 6 + j) / n
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