Xuân Thanh > 26-07-18, 11:59 AM
vuthaiha90 > 28-07-18, 03:12 AM
(26-07-18, 11:59 AM)Xuân Thanh Đã viết: Cách 1 : Làm 3 file tổng hợp của 3 người riêng rẽ rồi làm một file khác tổng hợp của 3 người lại bằng phương pháp copy sheet TongHop ra một Workbook mới để xử lý
Cách 2 : Dùng ADODB hoặc Array để tăng tốc độ, chắc giảm được một nửa thời gian chờ đợi
Lúc nào rảnh thì viết cho
vuthaiha90 > 27-08-18, 11:06 AM
Sub ChonFileG035841()
Dim i As Long, j As Long
j = S01.Range("B1000000").End(xlUp).Row
S01.Range("B1:B" & j).ClearContents
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
For i = 1 To .SelectedItems.Count
S01.Range("B" & i) = .SelectedItems(i)
Next
End With
End Sub
Sub ChonFileG034821()
Dim i As Long, j As Long
j = S01.Range("C1000000").End(xlUp).Row
S01.Range("C1:C" & j).ClearContents
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
For i = 1 To .SelectedItems.Count
S01.Range("C" & i) = .SelectedItems(i)
Next
End With
End Sub
Sub TongHop()
Application.ScreenUpdating = False
Dim i As Long, m As Long
Dim nFile As Long
Dim Wb As Workbook
Dim Ws As Worksheet
Dim cCell As Range
Dim myarray As Variant
If S01.Range("B1") <> "" Then
nFile = S01.Range("B1000").End(xlUp).Row
With S02
.Range("A3:FO818").ClearContents
For i = 1 To nFile
Set Wb = Workbooks.Open(S01.Range("B" & i))
Set Ws = Wb.Worksheets("G035841")
If i = 1 Then .Range("A3:A817").Value = Ws.Range("B19:B834").Value
Set cCell = .Range("1:1").Find(Ws.Range("C3").Value, , xlValues, xlWhole, , , True)
If Not cCell Is Nothing Then
cCell.Offset(2).Resize(816, 2).Value = Ws.Range("H19:I835").Value
End If
Wb.Close False
Set Wb = Nothing
Next
.Range("B3:B818").Resize(, S02.UsedRange.Columns.Count).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
End With
If S01.Range("C1") <> "" Then
nFile = S01.Range("C1000").End(xlUp).Row
With S02
.Range("A821:FO824").ClearContents
.Range("A821") = S01.Range("A5")
.Range("A822") = S01.Range("A6")
.Range("A823") = S01.Range("A7")
.Range("A824") = S01.Range("A8")
For i = 1 To nFile
Set Wb = Workbooks.Open(S01.Range("C" & i))
Set Ws = Wb.Worksheets("G034821")
.Cells(820, i * 2) = .Cells(1, i * 2)
m = Ws.Range("D1000000").End(xlUp).Row
Set cCell = .Range("1:1").Find(Ws.Range("C3").Value, , xlValues, xlWhole, , , True)
If Not cCell Is Nothing Then
cCell.Offset(820).Resize(1, 4).Value = Ws.Range("D" & m & ":G" & m).Value
myarray = Array(cCell.Offset(820).Resize(1, 4))
cCell.Offset(820).Resize(4, 1).Value = Application.Transpose(myarray)
cCell.Offset(820, 1).Resize(1, 3).ClearContents
End If
Wb.Close False
Set Wb = Nothing
Next
.Range("B821:B824").Resize(, S02.UsedRange.Columns.Count).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
End With
End If
MsgBox "Xong"
End Sub
khuuquytrung > 16-01-19, 11:45 PM