错误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