Nhờ Anh Chị diễn đàn giúp đỡ code VBA

Liên hệ QC

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 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
 

File đính kèm

  • BC_Ngay_K6-1 (7) (3).xlsm
    1.7 MB · Đọc: 7
  • Bao_Cao_Tong_Cua_Tuan (4) (3).xlsm
    189.4 KB · Đọc: 5
Web KT

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

Back
Top Bottom