Cần Giúp đỡ Tính Tổng Của 2 Worksheet

[TranThanhPhong]

Chào bạn,

Bạn thêm biến lấy đường dẫn tới thư mục chứa các tập tin:

txtPath = ActiveWorkbook.Path
Workbooks.Open Filename:=txtPath & "\" & "TEST1.xls"


TP.

 

[ThuNghi]

Bác Phong ơi, trong VBA có câu lệnh nào như câu lệnh của Fox: "set defa to d:\....\....\" không, chỉ hộ nhé. Cám ơn nhiều.

 

[tedaynui]

Bác Phong ơi, trong VBA có câu lệnh nào như câu lệnh của Fox: "set defa to d:\....\....\" không, chỉ hộ nhé. Cám ơn nhiều.

ThuNghi dùng thử cậu lệnh này xem

Application.DefaultFilePath = "[B]PathName[/B]"

TDN

 

[anhtuan1066]

Cám ơn bạn ThuNghi nhắc nhở về việc đặt Name. Chẳng hiểu vì sao lại ngu ngơ đến mức đặt 1 đóng Name thế kia ??? Còn dung lượng file lớn thì tôi phát hiện ra rồi: Do rác nằm khắp nơi. Lúc copy công thức kéo xuống, rồi lại xóa, rồi lại thêm... có những công thức ko sữ dụng nắm ở cell thứ mấy ngàn mà mình ko biết... Hi.. hi... (Xóa hết những công thức thừa, cuối cùng file còn có 500KB)... Thanks...
ANH TUẤN

 

[ThuNghi]

To ptaquan
Hôm nay không tham gia được SN, ngồi buồn quá modify lại code cho bạn, có nhiều cái chưa cải tiến lắm nhưng mà dần dần mà. Có bổ sung các file nằm trong 1 thư mục.

Sub CopyData()
Dim FirstRow As Integer, FirstCol As Integer
Dim LastRow As Integer, LastCol As Integer
Dim txtPath As String
'TxtPath de tim duong dan
txtPath = ActiveWorkbook.Path
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Xoa du lieu neu co
Sheets("Sheet2").Range("A11000").ClearContents
'mo test1 'neu co the them kiem tra file co ton tai
Workbooks.Open Filename:=txtPath & "\" & "TEST1.xls"
'Lay so dong cua Test1
LastRow = ActiveCell.CurrentRegion.Rows.Count
Range(Cells(1, 1), Cells(LastRow, 4)).Copy
'mo test total va dan
Windows("Test total.xls").Activate
Sheets("Sheet2").Select
Sheets("Sheet2").Range("a1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'dong test1
Windows("TEST1.xls").Activate
ActiveWindow.Close
'Mo Test2
Workbooks.Open Filename:=txtPath & "\" & "TEST2.xls"
'Lay so dong cua Test2
LastRow = ActiveCell.CurrentRegion.Rows.Count
'Cells(2,1) copy tu dong 2 do bo dong tieu de
Range(Cells(2, 1), Cells(LastRow, 4)).Copy
'mo test total va dan
Windows("Test total.xls").Activate
'Tim dong dau de dan
FirstRow = ActiveCell.CurrentRegion.Rows.Count
Sheets("Sheet2").Range("a" & FirstRow + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'dong test2
Windows("TEST2.xls").Activate
ActiveWindow.Close
'tao danh muc
Sheets("Sheet2").Select
'xoa ket qua loc
Range("H1:K1000").ClearContents
'Lay dong cuoi cua ket qua va dat name
LastRow = Range("C65000").End(xlUp).Row
Range("A1" & " :A" & LastRow).Name = "MAHANG"
Range("A1" & " :B" & LastRow).Name = "DMHangHoa"
Range("C1" & " :C" & LastRow).Name = "SOLUONG"
Range("MAHANG").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, 8), Unique:=True
'Lay dong cuoi cua ket qua
LastRow = Range("H65000").End(xlUp).Row
For i = 2 To LastRow
Cells(i, 10).Value = "=SUMIF(MAHANG,RC1,SOLUONG)"
Cells(i, 9).Value = "=vlookup(RC1,DMHangHoa,2,0)"
Next i
Range("H2:K" & LastRow).Copy
Sheets("Sheet1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Sheet2").Range("a1:K1000").ClearContents
Sheets("Sheet1").Select

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.Names("MAHANG").Delete
.Names("SOLUONG").Delete
.Names("DMHangHoa").Delete
End With
End Sub

Một cách nghiên cứu hay là cắt code thành từng code nhỏ xem nó chạy ra sao.