vấn đề này dùng mảng có được không nhỉ?

[ttranhnn]

Các bác cho em hỏi, em có một số tập tin dữ liệu, ví dụ CTNA,CTBT,CTCL,DTNA,DTPQ....em viết macro xử lý riêng cho từng tập tin, nhưng khi chạy nó báo lỗi procedure too large, giờ em muốn thay vì xử lý riêng từng tập tin, em có thể gán cho tên file là một mảng sau đó dùng vòng lặp để thu gọn lại được không nhỉ?

 

[sealand]

Không có lỗi gì trong ý tưởng và cách làm đó (Ông Bill cũng làm vậy). Sai là câu lệnh hay lỗi sử lý cơ?

 

[ttranhnn]

nhưng dùng mảng thì phải khai báo như thế nào?nếu dùng mảng thì làm sao để sử dụng vòng lặp khi chạy từ CTNA....đến DTPQ...đến hết ạ?

 

[ttranhnn]

Sub dung()
Dim i As String
Dim tennh(5) As String
tennh(0) = "ACBNA"
tennh(1) = "DDNA"
tennh(2) = "MSBNA"
tennh(3) = "KTNA"
tennh(4) = "VPBNA"
For i = tennh(0) To tennh(4)
Application.Workbooks.Open "C:\Tong hop toan dia ban\i.xls"
ActiveSheet.Unprotect
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Sheets("Tong hop toan dia ban").Select
Range("A1").Select
Selection.Copy
Windows("i.xls").Activate
Columns("A:J").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "i"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Microsoft Sans Serif"
.FontStyle = "Regular"
.Size = 8.25
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close
Name "C:\Tong hop toan dia ban\i.xls" As "C:\Tong hop toan dia ban\data.xls"
'mo 2 file data va tao cd ktoan'
Application.Workbooks.Open "C:\Tong hop toan dia ban\data.xls"
Application.Workbooks.Open "C:\Tong hop toan dia ban\Tao cd ktoan ver1.0.xls"
'copy so lieu tu file tao can doi ktoan vao'
Windows("Tao cd ktoan ver1.0.xls").Activate
Sheets("GSTX").Select
Range("A194").Select
Selection.Copy
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Sheets("i").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D2").Select
Columns("B:B").ColumnWidth = 17.29
Columns("C:C").ColumnWidth = 13.86
Columns("C:C").ColumnWidth = 17.71
Columns("B:B").ColumnWidth = 24.29
Columns("B:B").ColumnWidth = 35.86
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Columns("B:B").Select
Selection.ColumnWidth = 39.71
Range("B6").Select
Windows("Tao cd ktoan ver1.0.xls").Activate
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Range("C15").Select
Windows("data.xls").Activate
ActiveWindow.Close
Kill "C:\Tong hop toan dia ban\data.xls"
Next
End Sub
khi chạy nó báo lỗi Type mismatch nhờ bác giúp đỡ với ạ

 

[ndu96081631]

Sub dung()
Dim i As String
Dim tennh(5) As String
tennh(0) = "ACBNA"
tennh(1) = "DDNA"
tennh(2) = "MSBNA"
tennh(3) = "KTNA"
tennh(4) = "VPBNA"
For i = tennh(0) To tennh(4)
Application.Workbooks.Open "C:\Tong hop toan dia ban\i.xls"
ActiveSheet.Unprotect
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Sheets("Tong hop toan dia ban").Select
Range("A1").Select
Selection.Copy
Windows("i.xls").Activate
Columns("A:J").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "i"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Microsoft Sans Serif"
.FontStyle = "Regular"
.Size = 8.25
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close
Name "C:\Tong hop toan dia ban\i.xls" As "C:\Tong hop toan dia ban\data.xls"
'mo 2 file data va tao cd ktoan'
Application.Workbooks.Open "C:\Tong hop toan dia ban\data.xls"
Application.Workbooks.Open "C:\Tong hop toan dia ban\Tao cd ktoan ver1.0.xls"
'copy so lieu tu file tao can doi ktoan vao'
Windows("Tao cd ktoan ver1.0.xls").Activate
Sheets("GSTX").Select
Range("A194").Select
Selection.Copy
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Sheets("i").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D2").Select
Columns("B:B").ColumnWidth = 17.29
Columns("C:C").ColumnWidth = 13.86
Columns("C:C").ColumnWidth = 17.71
Columns("B:B").ColumnWidth = 24.29
Columns("B:B").ColumnWidth = 35.86
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Columns("B:B").Select
Selection.ColumnWidth = 39.71
Range("B6").Select
Windows("Tao cd ktoan ver1.0.xls").Activate
Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
Range("C15").Select
Windows("data.xls").Activate
ActiveWindow.Close
Kill "C:\Tong hop toan dia ban\data.xls"
Next
End Sub
khi chạy nó báo lỗi Type mismatch nhờ bác giúp đỡ với ạ

Nhìn sơ cũng thấy code vừa luộm thuộm lại sai cả... thúng luôn!
Muốn gì thì muốn, bạn cứ gữi lên đây vài file cho tiện việc kiểm tra ---> Làm chay kiểu này mệt xác lắm

 

[ttranhnn]

hì, em mới tập làm VBA mà bác thông cảm.làm sao để attach file rar lên được nhỉ

 

[ttranhnn]

à đây rồi, fải đổi sang khung lớn mới có

 

[ndu96081631]

à đây rồi, fải đổi sang khung lớn mới có

Chán bạn quá ---> Remove Pass VBA trước đi rồi hẳn gữi lên đây (nói chung là tất cả pass nào)
Ngoài ra cũng nên nói cho rõ ý định của bạn (nhìn code mà đoán ý cũng được nhưng... mỏi mắt lắm)

 

[ttranhnn]

hì,sorry mình quên:
ý mình là định dạng các file DDNA,KTNA.... sau đó đổi tên sang là data.xls, chạy file taocdketoan dể tạo cân đối và copy vào các sheet tương ứng cho ở file tổng hợp toàn địa bàn
gửi lại bác file rar

 

[ndu96081631]

hì,sorry mình quên:
ý mình là định dạng các file DDNA,KTNA.... sau đó đổi tên sang là data.xls, chạy file taocdketoan dể tạo cân đối và copy vào các sheet tương ứng cho ở file tổng hợp toàn địa bàn
gửi lại bác file rar

Có ai rành về kế toán thì giúp giùm ---> Mình xem file nảy giờ mà sao thây nó cứ mơ mơ hồ hồ thế nào ấy

 

[sealand]

Mình thấy bạn tiết kiệm ngôn ngữ quá nên khó hiểu, mình viết lại quy trình xem đúng không nhé:
1/Dọn dẹp lên báo cáo: Xoá các sheet báo cáo cũ trong file tổng hợp để chuẩn bị lên báo cáo.
2/Lần lượt đổi tên các file trong Danh sách thành Data để trở thành nguồn cho file tạo CDSP
3/Mở file CDPS chép Sheet CDPS vào file tổng hợp
4/Tiếp tục đến hết DSách

Như vậy có đúng không?

 

[ttranhnn]

ko có bước 1 bác ạ,
bước 2 unprotect, chuyển dữ liệu text sang number, insert thêm 1 dòng, và thêm tên của file vào dòng đầu, rồi mới đổi sang data

 

[ttranhnn]

em mới tập tành VBA có gì các bác chỉ giáo

 

[ndu96081631]

em mới tập tành VBA có gì các bác chỉ giáo

Tôi áng chừng bài này cũng không khó... vấn đề nằm ở chổ "Bạn mô tả khó hiểu quá" nên chẳng giúp được gì

 

[sealand]

Mình thử rồi khi đổi file thành file nguồn là Data nhưng số liệu trên file tạo cdps báo lỗi
Tại sao lại không dùng cách chép dữ liệu từ file data vào file tạo CDPS nhỉ? Như vậy, đỡ mất thời gian chờ cập nhật.
Bạn thử tạo file như vậy xem sao
Đúng như Ndu nói viết Code vận hành không khó và ngắn bằng 1/10 các đoạn Code hàng khủng của bạn ấy, chỉ chết nỗi là công thức kiểu Link chặt như thế này không chịu Refresh số liệu khi đưa 1 file mang tên DATA.xls
Bạn thử bằng cách làm bằng tay. Đổi tên 1 file thành Data rồi Refresh dữ liệu mà xem, lỗi ngay.

 

[sealand]

Mình gửi code chép theo phương án của bạn, nhưng không cho kết quả đúng vì việc đổi tên thay thế file nguồn có lẽ không được. Nếu có được thì phải thêm Sleep để chờ Update

Sub THop()
Dim Sh1 As Worksheet, FName(), i, Pat
Dim Wb1 As Workbook, Wb2 As Workbook
'Don dep
Application.DisplayAlerts = False
For Each Sh1 In ThisWorkbook.Sheets
If Sh1.CodeName <> "Main" Then Sh1.Delete
Next
Set Wb1 = ThisWorkbook
FName = Array("ACBNA.xls", "DDNA.xls", "KTNA.xls", _
"MBNA.xls", "MSBNA.xls", "VPBNA.xls")
Pat = Wb1.Path
For i = 0 To UBound(FName) - 1
Set Sh1 = Wb1.Sheets.Add
Sh1.Name = Replace(FName(i), ".xls", "")
Set Wb2 = Application.Workbooks.Open(Wb1.Path & "\Tao cd ktoan ver1.0.xls")
Name Wb1.Path & "\" & FName(i) As Wb1.Path & "\DATA.xls"
    Windows("Tao cd ktoan ver1.0.xls").Activate
    Worksheets(1).Cells.Copy
    Windows("Tong hop du lieu gstx toan dia ban.xls").Activate
    Sh1.Paste
Name Wb1.Path & "\DATA.xls" As Wb1.Path & "\" & FName(i)
Next
Wb2.Close
End Sub

 

[ttranhnn]

Mình thử rồi khi đổi file thành file nguồn là Data nhưng số liệu trên file tạo cdps báo lỗi
Tại sao lại không dùng cách chép dữ liệu từ file data vào file tạo CDPS nhỉ? Như vậy, đỡ mất thời gian chờ cập nhật.
Bạn thử tạo file như vậy xem sao
Đúng như Ndu nói viết Code vận hành không khó và ngắn bằng 1/10 các đoạn Code hàng khủng của bạn ấy, chỉ chết nỗi là công thức kiểu Link chặt như thế này không chịu Refresh số liệu khi đưa 1 file mang tên DATA.xls
Bạn thử bằng cách làm bằng tay. Đổi tên 1 file thành Data rồi Refresh dữ liệu mà xem, lỗi ngay.

Mấy hôm nay mưa bão to quá nên ko vào mạng được. Thanks bác đã trả lời,
giờ làm thủ công thì thế này ạ:
em có 6 file dữ liệu nguồn là ACBNA,DDNA,KTNA,MBNA,MSBNA,VPBNA
đây mới chỉ là các file cân đối tài khoản kế toán
giờ em phải nhặt các tài khoản để tạo thành một bảng cân đối tài sản nguồn vốn và 1 bảng nữa là các chỉ tiêu để theo dõi giám sát (ở sheet 2 trong file tạo cdtkkt)
nếu làm thủ công e phải xử lý từng file 1 đầu tiên là file ACBNA:
mở file ACBNA=>unprotect=>chuyển từ định dạng kiểu chữ sang định dạng kiểu số=>insert thêm 1 dòng trống vào dòng đầu tiên=>đánh vào chữ ACBNA => save và close file lại => đổi tên file thành data.xls và mở ra => mở file tao cdkt để cập nhật số liệu => sang sheet GSTX copy toàn bộ sheet vào sheet ACBNA ở file tong hop du lieu gstx toan dia ban.xls
sau khi copy xong xoá file data.xls em đã thực hiện bằng lệnh kill rồi tiếp tục thực hiện tương tự cho các file dư liệu DDNA,VPBNA...
em muốn tự động hoá các khâu trên nhưng e thấy code của e viết dài quá nên e mới up lên nhờ các bác chỉnh giúp

 

[sealand]

Bạn Upload file không còn nguyên bản nên rất khó kiểm tra. Cái bạn nói Unprotect thì lại chả thấy Protect ở đâu. Dòng bạn bảo thêm thì lại thấy đã có không biết có nên thêm nữa không.Quy trình của bạn rất khó kiểm soát công thức.
Mình đề nghị nên thây đổi 1 chút sẽ thuận lợi cho việc vận hành code.
1/File Tao cd ktoan ver1.0.xls bạn thêm 1 sheet DATA. Bảng CDPS sẽ tính toán dựa trên sheet DATA này. Như vậy công thức sẽ ổn định và nhanh hơn nhiều so với tổng hợp từ dữ liệu Link.
2/Trình tự hoạt động:
+Mở 2 file Tao cd ktoan ver1.0.xls và Tong hop du lieu gstx toan dia ban.xls
+Lần lượt với các file còn lại:
Mở file của 1 dơn vị ---->Chép Sheet 1(Đơnvi báo cáo) vào Sheet DATA (Tao cd ktoan ver1.0.xls) --->Tao Sheet Tên DVi (Tong hop du lieu gstx toan dia ban.xls)---->Chép CDPS (Tao cd ktoan ver1.0.xls) và Paste vào Sheet Tên DVi (Tong hop du lieu gstx toan dia ban.xls)

Tiếp tục cho đến hết. Như vậy, ta không hề làm thay đổi của các file báo cáo của các đơn vị gửi lên. Ta chỉ mở nó ra chép lấy dữ liệu rồi đóng lại. Không tồn tại những đường link hàng khủng nữa. Bạn cho ý kiến nhé.

 

[ttranhnn]

trong cái mình gửi có file ACBNA là đã được mình định dạng bằng thủ công mình gửi lại là file nguyên bản. Ý của bạn rất hay để mình xem đã nhé.
Mình đang thử với 2 file ACBNA và DDNA nhưng vòng lặp nó cứ báo lỗi ko tìm thấy file là sao nhỉ?nhờ bạn giúp với (bạn chạy cái macro vonglap trong thu mục thang7 mình gui kèm đây).

 

[sealand]

Bạn chỉ cho biết bạn chạy Macro nào không? Minh đoán là

Bạn viết code mở file như sau:

Application.Workbooks.Open ThisWorkbook.Path & "\" & Fname(i)

Như vậy, thư mục này ở đâu cũng không bị lỗi đường dẫn. Ban lưu ý cách kết hợp chuỗi và biến nha