錯誤1400：沒有滿足標準的此類單元格

Question

以下是應用過濾器後複製數據的代碼。

Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) 

Dim work_book As Object 
Dim destination_workbook As Object 
Dim i, m As Integer 
Dim array_of_account_numbers() As Variant 
Dim array_of_debit_or_credits() As Variant 
Dim current_sheets As Worksheet 
Dim buf_rng As Range 

array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") 
array_of_debit_or_credits = Array("10", "11", "20", "21") 

Application.DisplayAlerts = False 
Application.Visible = True 

Set work_book = Workbooks.Open(path_to_current_work_book) 
Set destination_workbook = Workbooks.Open(path_to_destination_workbook) 

destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" 
destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" 
destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" 
destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" 
destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" 
destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" 

m = 2 
For i = 1 To work_book.Worksheets.Count 
    With work_book.Sheets(i) 
     If (.UsedRange.Rows.Count > 1) Then 
      .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
      .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
      m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).row + 1 
      .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) 
     End If 
    End With 
Next i 
work_book.Close savechanges:=False 
destination_workbook.Close savechanges:=True 
End Sub 

它產生以下錯誤（當autofiltered範圍，不包括報頭，是空的）：「錯誤1400：不存在這樣的細胞，其saticfies規定 - 」。

.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) 

我該如何處理這個錯誤？

Answer 1

它設置爲一個範圍，然後檢查的範圍是Nothing

試試這個（未經測試）

Dim Rng as Range 

' 
'~~> Rest of your code 
' 

On Error Resume Next 
Set Rng = .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count _ 
      - 1).SpecialCells(xlCellTypeVisible) 
On Error GoTo 0 

If Not Rng Is Nothing Then 
    'rng.copy... blah blah 
End If 

Answer 2

如果你的數據在列表範圍內（我認爲這是必須是自動篩選）並且每張紙上只有一個表/列表，然後使用work_book.Sheets(i)使用With work_book.Sheets(i).ListObjects(1)

下面是我的意思的未經測試的樣本。

Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) 

Dim work_book As Object 
Dim destination_workbook As Object 
Dim i, m As Integer 
Dim array_of_account_numbers() As Variant 
Dim array_of_debit_or_credits() As Variant 
Dim current_sheets As Worksheet 
Dim buf_rng As Range 

array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") 
array_of_debit_or_credits = Array("10", "11", "20", "21") 

Application.DisplayAlerts = False 
Application.Visible = True 

Set work_book = Workbooks.Open(path_to_current_work_book) 
Set destination_workbook = Workbooks.Open(path_to_destination_workbook) 

destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" 
destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" 
destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" 
destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" 
destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" 
destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" 

m = 2 
For i = 1 To work_book.Worksheets.Count 
    With work_book.Sheets(i).ListObjects(1) 
     If (.Rows.Count > 1) Then 
      .AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
      .AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
      m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1 
      If .Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then 
       .Range.Offset(1, 0).Resize(.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1).copy destination_workbook.Sheets(1).Range("A" & m) 
      End If 
     End If 
    End With 
Next i 
work_book.Close savechanges:=False 
destination_workbook.Close savechanges:=True 
End Sub 

其實我可得太多這件事嘗試下面的代碼，它只是檢查是否過濾的範圍包含更多的則只是1個標題行，如果是的話那麼它會複製，如果它不它跳過它，我相信這是你所需要的。

Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) 

Dim work_book As Object 
Dim destination_workbook As Object 
Dim i, m As Integer 
Dim array_of_account_numbers() As Variant 
Dim array_of_debit_or_credits() As Variant 
Dim current_sheets As Worksheet 
Dim buf_rng As Range 

array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") 
array_of_debit_or_credits = Array("10", "11", "20", "21") 

Application.DisplayAlerts = False 
Application.Visible = True 

Set work_book = Workbooks.Open(path_to_current_work_book) 
Set destination_workbook = Workbooks.Open(path_to_destination_workbook) 

destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" 
destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" 
destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" 
destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" 
destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" 
destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" 

m = 2 
For i = 1 To work_book.Worksheets.Count 
    With work_book.Sheets(i) 
     If (.UsedRange.Rows.Count > 1) Then 
      .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
      .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
      m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1 
      If (.AutoFilter.Range.Rows.Count > 1) Then 
       .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).copy destination_workbook.Sheets(1).Range("A" & m) 
      End If 
     End If 
    End With 
Next i 
work_book.Close savechanges:=False 
destination_workbook.Close savechanges:=True 
End Sub 

Answer 3

以下是生成所需結果的工作代碼。我相信，這個代碼還有一些改進的餘地，如果有人糾正它，我會很感激。我想感謝user2140261和SiddharthRout給我有用的建議以及分享他們的代碼。

Sub extractInformationFromExcelFiles() 
Dim path_to_folder As String 
Dim path_to_final_file As String 
Dim path_to_current_file As String 
Dim objfso As Object 
Dim objfolder As Object 
Dim obj_sub_folder As Object 
Dim objfile As Object 
Dim final_workbook As Workbook 

path_to_folder = "" 
path_to_final_file = "" 

Set objfso = CreateObject("Scripting.FilesystemObject") 
Set objfolder = objfso.getfolder(path_to_folder) 

For Each obj_sub_folder In objfolder.subfolders 
    For Each objfile In obj_sub_folder.Files 
     path_to_current_file = path_to_folder & obj_sub_folder.name & "\" & objfile.name 
     On Error Resume Next 
     readExcelFile path_to_current_file, path_to_final_file 
     On Error GoTo 0 
    Next objfile 
Next obj_sub_folder 
Set final_workbook = Workbooks.Open(path_to_final_file) 
End Sub 

Sub readExcelFile(path_to_current_work_book As String, path_to_destination_workbook As String) 

Dim work_book As Object 
Dim destination_workbook As Object 
Dim i, m As Integer 
Dim array_of_account_numbers() As Variant 
Dim array_of_debit_or_credits() As Variant 
Dim current_sheets As Worksheet 
Dim buf_rng As Range 

array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") 
array_of_debit_or_credits = Array("10", "11", "20", "21") 

Application.DisplayAlerts = False 
Application.Visible = True 

Set work_book = Workbooks.Open(path_to_current_work_book) 
Set destination_workbook = Workbooks.Open(path_to_destination_workbook) 

destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" 
destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" 
destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" 
destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" 
destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" 
destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" 
destination_workbook.Sheets(1).Cells(1, 7).Value = "Bank name under NBU classification" 

m = 2 
For i = 1 To work_book.Worksheets.Count 
    With work_book.Sheets(i) 
     If (.UsedRange.Rows.Count > 1) Then 
      .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues 
      .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues 
      m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).row + 1 
      If (.AutoFilter.Range.Rows.Count > 1) Then 
      On Error Resume Next 
       .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) 
      On Error GoTo 0 
      End If 
     End If 
    End With 
Next i 
work_book.Close savechanges:=False 
destination_workbook.Close savechanges:=True 
End Sub