Lỗi code khi vùng cập nhật không có số liệu (1 người xem)

[phuocrobe]

Mình có 1 file tổng hợp dữ liệu từ các file có tên nằm trong vùng B4:B33 sheet HUONGDAN.
Trường hợp các file có dữ liệu đầy đủ thì code chạy rất ok, nhưng trong trường hợp ở vùng B16:S45 sheet M06 của các file1.xls hoặc file2.xls, file3.xls không có dữ liệu thì code báo lỗi tại dòng Arr3(K, J) = sArr(I, J)

Nhờ anh chị giúp em làm sao để code vẫn có thể chạy dù có 1 vài file không có dữ liệu, vì mình phải làm báo cáo này thường xuyên nên cũng có trường hợp không có dữ liệu à. Cám ơn các anh chị rất nhiều

Public Sub GPE1()
Application.ScreenUpdating = False
Dim sArr(), Arr1(1 To 16, 1 To 12), Arr2(1 To 26, 1 To 1), Arr3(1 To 1000, 1 To 18), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = .Sheets("HUONGDAN").Range("B4", .Sheets("HUONGDAN").Range("B65536").End(xlUp)).Value
End With
For N = 2 To UBound(tArr)
'K = K + 1
Workbooks.Open Filename:=Pat & tArr(N, 1)
sArr = ActiveWorkbook.Sheets("M01").Range("C11:N26").Value
For I = 1 To 16
For J = 1 To 12
Arr1(I, J) = Arr1(I, J) + sArr(I, J)
Next J
Next I
sArr = ActiveWorkbook.Sheets("M01.1").Range("C4:C29").Value
For I = 1 To 26
Arr2(I, 1) = Arr2(I, 1) + sArr(I, 1)
Next I
sArr = ActiveWorkbook.Sheets("M06").Range("B15:S45").Value
For I = 1 To 31
K = K + 1
For J = 1 To 18
Arr3(K, J) = sArr(I, J)
Next J
Next I
ActiveWindow.Close False
Next N
Workbooks(MyName).Activate
Sheets("M01").Range("C11:N26") = Arr1
Sheets("M01.1").Range("C4:C29") = Arr2
Sheets("M06").Range("B15:S15").Resize(K) = Arr3
Application.ScreenUpdating = False
End Sub
Public Sub GPE()
Application.ScreenUpdating = False
Dim sArr(), Arr1(1 To 16, 1 To 12), Arr2(1 To 26, 1 To 1), Arr3(1 To 1000, 1 To 18), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = .Sheets("HUONGDAN").Range("B4", .Sheets("HUONGDAN").Range("B65536").End(xlUp)).Value
End With
For N = 2 To UBound(tArr)
Workbooks.Open Filename:=Pat & tArr(N, 1)
With ActiveWorkbook
sArr = .Sheets("M01").Range("C11:N26").Value
For I = 1 To 16
For J = 1 To 12
Arr1(I, J) = Arr1(I, J) + sArr(I, J)
Next J
Next I
sArr = .Sheets("M01.1").Range("C4:C29").Value
For I = 1 To 26
Arr2(I, 1) = Arr2(I, 1) + sArr(I, 1)
Next I
sArr = .Sheets("M06").Range("B15", .Sheets("M06").Range("B15").End(xlDown)).Resize(, 18).Value
For I = 1 To UBound(sArr)
K = K + 1
For J = 1 To 18
Arr3(K, J) = sArr(I, J)
Next J
Next I
End With
ActiveWindow.Close False
Next N
Workbooks(MyName).Activate
Sheets("M01").Range("C11:N26") = Arr1
Sheets("M01.1").Range("C4:C29") = Arr2
With Sheets("M06")
.Range("b15").Resize(1000, 18).ClearContents
.Range("b15").Resize(1000, 18).Font.Bold = False
.Range("b15:S15").Resize(K) = Arr3
For I = 1 To K
If Arr3(I, 1) = Empty Then .Range("b" & I + 14).Resize(, 18).Font.Bold = True
Next I
End With
End Sub

 

[Hoang2013]

Thứ nhất, mình vốn không ưa chuyện gộp & tách file này lắm;
Với mình chuyện này là không có lí do gì chính đáng cả, xin lỗi bạn!

Kế đến: Bạn cần bẩy lỗi ngay sau dòng đầu tiên của trích dẫn sau:

sArr = ActiveWorkbook.Sheets("M06").Range("B15:S45").Valu  e
    For I = 1 To 31
        K = K + 1
        For J = 1 To 18'
            Arr3(K, J) = sArr(I, J)'
        Next J
    Next I

Mình không rõ lắm; Nếu dòng 15 là dòng chứa dữ liệu, còn trên nó là tiêu đề trường/cột
thì bạn có thể xài câu lệnh sau:

     Dim Rws as long 
[B]      Rws=[B]ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Rows.Count
[/B]'      Chỉ khi trị trong Rws>0 ta mới có thể thực hiện lệnh:'
     sArr = ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Value[/B]

 

[phuocrobe]

Mình code lại như thế này không biết có đúng chưa mà sao kết quả vẫn chưa đúng như mong đợi à.

1. Mình muốn lấy dữ liệu từ vùng B15:S45 sheet M06 của các file1,2,3 sang vùng B15:S1000 sheet M06 của file TongHop nhưng kết quả lại thiếu mất dòng B15:S15 của các file1,2,3.

2. Dữ liệu ở cột B sheet M06 file TongHop không hiển thị đúng dữ liệu ở cột B sheet M06 của các file1,2,3 mà lại hiển thị cột số thứ tự.

Public Sub GPE()Application.ScreenUpdating = False
Dim sArr(), Arr1(1 To 16, 1 To 12), Arr2(1 To 26, 1 To 1), Arr3(1 To 1000, 1 To 18), tArr()
Dim MyName As String, Pat As String, I As Long, J As Long, K As Long, N As Long
Dim Rws As Long
Rws = ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Rows.Count
With ActiveWorkbook
MyName = .Name
Pat = .Path & ""
tArr = .Sheets("HUONGDAN").Range("B4", .Sheets("HUONGDAN").Range("B65536").End(xlUp)).Value
End With
For N = 2 To UBound(tArr)
Workbooks.Open Filename:=Pat & tArr(N, 1)
With ActiveWorkbook
sArr = .Sheets("M01").Range("C11:N26").Value
For I = 1 To 16
For J = 1 To 12
Arr1(I, J) = Arr1(I, J) + sArr(I, J)
Next J
Next I
sArr = .Sheets("M01.1").Range("C4:C29").Value
For I = 1 To 26
Arr2(I, 1) = Arr2(I, 1) + sArr(I, 1)
Next I
sArr = ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Value
For I = 1 To UBound(sArr)
K = K + 1
For J = 1 To 18
Arr3(K, J) = sArr(I, J)
Next J
Next I
End With
ActiveWindow.Close False
Next N
Workbooks(MyName).Activate
Sheets("M01").Range("C11:N26") = Arr1
Sheets("M01.1").Range("C4:C29") = Arr2
With Sheets("M06")
.Range("b15").Resize(1000, 18).ClearContents
.Range("b15").Resize(1000, 18).Font.Bold = False
.Range("b15:S15").Resize(K) = Arr3
For I = 1 To K
If Arr3(I, 1) = Empty Then .Range("b" & I + 14).Resize(, 18).Font.Bold = True
Next I
End With
End Sub

Thứ nhất, mình vốn không ưa chuyện gộp & tách file này lắm;
Với mình chuyện này là không có lí do gì chính đáng cả, xin lỗi bạn!

Kế đến: Bạn cần bẩy lỗi ngay sau dòng đầu tiên của trích dẫn sau:

sArr = ActiveWorkbook.Sheets("M06").Range("B15:S45").Valu  e
    For I = 1 To 31
        K = K + 1
        For J = 1 To 18'
            Arr3(K, J) = sArr(I, J)'
        Next J
    Next I

Mình không rõ lắm; Nếu dòng 15 là dòng chứa dữ liệu, còn trên nó là tiêu đề trường/cột
thì bạn có thể xài câu lệnh sau:

     Dim Rws as long 
[B]      Rws=[B]ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Rows.Count
[/B]'      Chỉ khi trị trong Rws>0 ta mới có thể thực hiện lệnh:'
     sArr = ActiveWorkbook.Sheets("M06").Range("B15").CurrentRegion.Offset(1).Value[/B]