Cần giúp viết Code cắt dữ liệu từ File này sang File kia trong trường hợp thiếu File (1 người xem)

hung2412 · 12/11/14

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có 4 File sổ kế toán là TK 621.xls, TK 622.xls, TK 623.xls, TK 627.xls (Mở đồng thời 4 File)=> Cắt dữ liệu từ dòng 8 đến dòng cuối ở từng File TK 622.xls, TK 623.xls, TK 627.xls rồi paste vào dòng bên dưới dòng cuối cùng ở File TK 621.xls (Để tổng hợp số liệu) => Tôi dùng Code:

PHP:

Sub Catdulieu()
Windows("TK 622.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
Windows("TK 623.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
Windows("TK 627.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
End Sub

Code trên chỉ thuận lợi khi có đủ 4 File ở trên. Nếu bị thiếu 1 hoặc 2 File (VD: Thiếu File TK 622.xls và TK 623.xls) do tháng đó không có phát sinh nghiệp vụ nên không có File => Code trên bị lỗi (Do thiếu File) => Có cách nào để khắc phục được tình trạng trên không ạ?
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 04 File đính kèm.

hung2412 · 15/11/14

Mong là có ai vào giúp đỡ với ạ.

ndu96081631 · 15/11/14

hung2412 đã viết:
Mong là có ai vào giúp đỡ với ạ.

Bạn bấm vào nút View Poll Results là biết liền chứ gì --=0

Hau151978 · 15/11/14

Bạn thêm lệnh on error resume next vào đầu sub.

hung2412 · 15/11/14

Hau151978 đã viết:
Bạn thêm lệnh on error resume next vào đầu sub.

Cái thêm lệnh on error resume next thì tôi biết mà. Nhưng mà không ổn ạ. Bởi vì, nếu File này thiếu thì Step Into bỏ qua dòng đó sẽ nhảy xuống dòng dưới => Thực hiện lệnh dòng dưới đó => Cắt dữ liệu lung tung luôn => Bạn thử mà xem.

Hau151978 · 15/11/14

Ngại test code của bạn. Để sửa cho nhanh, bạn chèn thêm các lệnh On error goto như sau:

PHP:

Sub Catdulieu()
On error goto a
Windows("TK 622.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
a: on error goto b
Windows("TK 623.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
b: on error goto c
Windows("TK 627.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
c:
End Sub

hung2412 · 15/11/14

Hau151978 đã viết:

Ngại test code của bạn. Để sửa cho nhanh, bạn chèn thêm các lệnh On error goto như sau:

PHP:

Sub Catdulieu()
On error goto a
Windows("TK 622.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
a: on error goto b
Windows("TK 623.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
b: on error goto c
Windows("TK 627.xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
c:
End Sub

Cảm ơn bạn, nhưng đáng tiếc là cách này tôi cũng từng thử qua và tôi thử lại cách bạn chỉ dẫn nhưng không được bạn ạ. Lệnh On error goto này chỉ bẫy được 1 lần thôi ạ => Không thể bẫy được nhiều lần.

Hau151978 · 15/11/14

hung2412 đã viết:
Cảm ơn bạn, nhưng đáng tiếc là cách này tôi cũng từng thử qua và tôi thử lại cách bạn chỉ dẫn nhưng không được bạn ạ. Lệnh On error goto này chỉ bẫy được 1 lần thôi ạ => Không thể bẫy được nhiều lần.

Xin lỗi bạn

Mã:

Sub tk(s As String)
On Error GoTo a
Windows("TK " & s & ".xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
a:
End Sub

Sub catdulieu()
tk (622)
tk (623)
tk (627)
End Sub

Quang_Hải · 15/11/14

hung2412 đã viết:
Cái thêm lệnh on error resume next thì tôi biết mà. Nhưng mà không ổn ạ. Bởi vì, nếu File này thiếu thì Step Into bỏ qua dòng đó sẽ nhảy xuống dòng dưới => Thực hiện lệnh dòng dưới đó => Cắt dữ liệu lung tung luôn => Bạn thử mà xem.

Không thử code, chỉ viết chay thôi. Bạn test thử xem thế nào
Giả định là file 621 luôn có đang mở

PHP:

Sub Catdulieu()
Dim WB As WorkBook, i&, chk As Boolean, List()
List = Array("TK 622.xls", "TK 623.xls", "TK 627.xls")
For i = 0 To UBound(List)
   For Each WB In Workbooks
      If WB.Name = List(i) Then
         chk = True
         Exit For
      End If
   Next
   If chk = True Then
      Windows(List(i)).Activate
      Range([A8], [H65536].End(xlUp)).EntireRow.Cut
      Windows("TK 621.xls").Activate
      [H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
      ActiveSheet.Paste
   End If
Next
End Sub

hung2412 · 15/11/14

Hau151978 đã viết:

Xin lỗi bạn

Mã:

Sub tk(s As String)
On Error GoTo a
Windows("TK " & s & ".xls").Activate
[H65000].End(xlUp).Select
Range([A8], [H65536].End(xlUp)).EntireRow.Cut
Windows("TK 621.xls").Activate
[H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
ActiveSheet.Paste
a:
End Sub

Sub catdulieu()
tk (622)
tk (623)
tk (627)
End Sub

Cảm ơn bạn đã chỉ dẫn cho tôi cái bẫy lỗi rất hay này, tôi đã text và đã chạy đúng như theo đề bài. Bạn vất vả thật.

Hau151978 · 15/11/14

quanghai1969 đã viết:

Không thử code, chỉ viết chay thôi. Bạn test thử xem thế nào
Giả định là file 621 luôn có đang mở

PHP:

Sub Catdulieu()
Dim WB As WorkBook, i&, chk As Boolean, List()
List = Array("TK 622.xls", "TK 623.xls", "TK 627.xls")
For i = 0 To UBound(List)
   For Each WB In Workbooks
      If WB.Name = List(i) Then
         chk = True
         Exit For
      End If
   Next
   If chk = True Then
      Windows(List(i)).Activate
      Range([A8], [H65536].End(xlUp)).EntireRow.Cut
      Windows("TK 621.xls").Activate
      [H65536].End(xlUp).Offset(1, 0).End(xlToLeft).Select
      ActiveSheet.Paste
   End If
Next
End Sub

Bác cần thêm lệnh chk=False vào dòng thứ 3 dưới lên để reset biến chk. Nếu không thì những lần sau chk luôn bằng True.

hung2412 · 15/11/14

Hau151978 đã viết:
Bác cần thêm lệnh chk=False vào dòng thứ 3 dưới lên để reset biến chk. Nếu không thì những lần sau chk luôn bằng True.

Đúng như bạn nói, thêm lệnh chk=False vào dòng thứ 3 dưới lên để reset biến chk thì mới chạy được.

Cần giúp viết Code cắt dữ liệu từ File này sang File kia trong trường hợp thiếu File (1 người xem)

Người dùng đang xem chủ đề này

hung2412

Thành viên tích cực

File đính kèm

hung2412

Thành viên tích cực

ndu96081631

Huyền thoại GPE

Hau151978

Thành viên tích cực

hung2412

Thành viên tích cực

Hau151978

Thành viên tích cực

hung2412

Thành viên tích cực

Hau151978

Thành viên tích cực

Quang_Hải

Thành viên gạo cội

hung2412

Thành viên tích cực

Hau151978

Thành viên tích cực

hung2412

Thành viên tích cực

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.