công việc chỉ là đưa dữ liệu từ sheet data2 sang các sheet bộ phận trong cùng 1 tệp tin bạn ạ.trên từng sheet có đủ dữ liệu để xử lý, tại sao phải lấy dữ liệu từ Data2?
Sub GPE_1()
Dim dArr(), sArr(), Arr(), tArr(), Dic As Object, Ws, I As Long, k As Byte, J As Byte, N
dArr = Sheets("Data2").Range("B14:FC" & Sheets("Data2").Range("B65500").End(xlUp).Row).Value
Set Dic = CreateObject("scripting.dictionary")
For I = 1 To UBound(dArr)
If dArr(I, 1) <> "" And Not Dic.Exists(dArr(I, 1)) Then Dic.Add dArr(I, 1), I
Next I
Ws = Array("SX", "QC", "Kho", "KT") 'Khai báo tên các Sheet
For k = LBound(Ws) To UBound(Ws)
tArr = Sheets(Ws(k)).Range("J14:AN14").Value
ReDim Arr(1 To 3, 1 To 31)
sArr = Sheets(Ws(k)).Range("G1:G" & Sheets(Ws(k)).Range("G65500").End(xlUp).Row).Value
For I = 15 To UBound(sArr) Step 8
If sArr(I, 1) <> "" And Dic.Exists(sArr(I, 1)) Then
For N = 1 To UBound(Arr)
For J = 1 To UBound(Arr, 2)
If tArr(1, J) > 0 Then Arr(N, J) = dArr(Dic.Item(sArr(I, 1)), (Day(tArr(1, J)) - 1) * 5 + N + 3)
Next J
Next N
Sheets(Ws(k)).Range("J" & I + 3).Resize(3, 31) = Arr
End If
Next I
Next k
Set Dic = Nothing
End Sub@Nguyễn Hoàng Oanh Thơ,
(1) Vậy mọi thứ đã đầy đủ rồi
(2) hình như lỗi chính tả...
(3)Hình như thiếu cái gì đó \Mã:filename = ThisWorkbook.Path & [COLOR=#0000ff]"" [/COLOR]& bo_phan(index) & ".xls"
Oanh Thơ chưa hiểu ý bạn lắm ạ, nếu Oanh Thơ trả lời không đúng ý bạn mong bạn giải thích thêm ạ.
Public Sub GPE_2()
Dim Dic As Object, sArr(), dArr(), tArr(), Tem As Long, iTm As Long
Dim I As Long, iK As Long, J As Long, Col As Long, N As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data2")
tArr = .Range("G1", .Range("G1").End(xlToRight)).Value
sArr = .Range("B14", .Range("B65536").End(xlUp)).Resize(, 158).Value
End With
For I = 1 To UBound(sArr)
Dic.Item(sArr(I, 1)) = I
Next I
For N = 1 To UBound(tArr, 2)
With Sheets(tArr(1, N))
Rws = .Range("G65536").End(xlUp).Row
For iK = 15 To Rws Step 8
Tem = .Range("G" & iK): Col = 0
If Dic.Exists(Tem) Then
iTm = Dic.Item(Tem)
ReDim dArr(1 To 2, 1 To 31)
For J = 5 To 158 Step 5
Col = Col + 1
dArr(1, Col) = sArr(iTm, J)
dArr(2, Col) = sArr(iTm, J + 1)
Next J
.Range("J" & iK + 4).Resize(2, 31) = dArr
End If
Next iK
End With
Next N
Set Dic = Nothing
MsgBox "Da thuc hien xong.", , "GiaiPhapExcel"
End Subcủa bạn ,như đã nêu ở bài 41 vì Oanh Thơ chưa biết cách vận dụng cho file thật của mình thôi ạ.
