☰

“应用程序定义或对象定义”错误‘1004’

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba sorting data-transfer
“应用程序定义或对象定义”错误‘1004’

我收到“应用程序定义...已定义”的 1004 运行时错误

并进行了一些格式调整

我收到 1004 运行时错误“排序引用无效。请确保它在您要排序的数据内，并且第一个排序依据框不相同或为空白。”

我对出现此错误的原因了解有限，VBA 编码知识也有限。我的代码在方法论上似乎与网络上的其他代码非常相似。是的，我的代码效率很低，除非这是解决方案的一部分，否则请不要批评它。

一切都运行正常，直到.sort那行出现错误。

我已将我的其他尝试保留在代码中，并注释掉“排序”下的“以便每个人都能了解所有事实”。

Sub Update()

Dim strCar As String
'Dim lastrow As Long
strcrit = "MAINT"

'Opening CSV
Workbooks.Open Filename:="G:\Common\Schedule Files\Workbook1.csv"
Workbooks.Open Filename:="G:\Common\Schedule Files\Workbook2.csv"

Workbooks("Combo.xlsm").Worksheets("SheetA1").Cells.ClearContents
Workbooks("Combo.xlsm").Worksheets("SheetB2").Cells.ClearContents

'Copying CSV to Workbook
Workbooks("Combo.xlsm").Worksheets("SheetA1").Range("A:I").Value = Workbooks("Workbook1.csv").Worksheets("Sheet1").Range("A:I").Value
Workbooks("Combo.xlsm").Worksheets("SheetB2").Range("A:I").Value = Workbooks("Workbook2.csv").Worksheets("Sheet2").Range("A:I").Value

'Close CSV
Workbooks("Workbook1.csv").Close False
Workbooks("Workbook2.csv").Close False

'AutoFilter
Workbooks("Combo.xlsm").Worksheets("Sheet1").Cells.Clear
Workbooks("Combo.xlsm").Worksheets("Sheet2").Cells.Clear

Workbooks("Combo.xlsm").Worksheets("SheetA1").Range("A:I").AutoFilter Field:=5, Criteria1:="=*" & strcrit & "*"
Workbooks("Combo.xlsm").Worksheets("SheetA1").Range("A:I").AutoFilter Field:=8, Criteria1:=">0"
Workbooks("Combo.xlsm").Worksheets("SheetA1").Range("A:I").SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Combo.xlsm").Worksheets("Sheet1").Range("A1")
Workbooks("Combo.xlsm").Worksheets("SheetB2").Range("A:I").AutoFilter Field:=5, Criteria1:="=*" & strcrit & "*"
Workbooks("Combo.xlsm").Worksheets("SheetB2").Range("A:I").AutoFilter Field:=8, Criteria1:=">0"
Workbooks("Combo.xlsm").Worksheets("SheetB2").Range("A:I").SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks("Combo.xlsm").Worksheets("Sheet2").Range("A1")


'SORTING
'Dim lastrow As Long
'lastrow = Cells(Rows.Count, 2).End(xlUp).Row
'Workbooks("Combo.xlsm").Worksheets("Sheet2").Range("A2:I" & lastrow).Sort Key1:=Range("B2:B" & lastrow), Order1:=xlAscending, Header:=xlNo

Worksheets("Sheet2").Range("A:I").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
Worksheets("Sheet1").Range("A:I").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

End Sub

答案1

我尝试让你的代码更易于管理，但尚未测试

这依赖于 UsedRange，因此从所有工作表上的 Combo.xlsm 中删除所有空行

要确定是否有空行，请在每张工作表上选择单元格A1，然后按Ctrl+End

Option Explicit
Public Sub SortAndCopyCSVs()
    Const CRIT = "MAINT"
    Const CSVF1 = "G:\Common\Schedule Files\Workbook1.csv"
    Const CSVF2 = "G:\Common\Schedule Files\Workbook2.csv"

    Dim wbCSV1 As Workbook:     Set wbCSV1 = Workbooks.Open(Filename:=CSVF1)
    Dim wbCSV2 As Workbook:     Set wbCSV2 = Workbooks.Open(Filename:=CSVF2)
    Dim wbCMBO As Workbook:     Set wbCMBO = Workbooks("Combo.xlsm")
    Dim wsCSV1 As Worksheet:    Set wsCSV1 = wbCSV1.Worksheets("Sheet1")
    Dim wsCSV2 As Worksheet:    Set wsCSV2 = wbCSV2.Worksheets("Sheet2")
    Dim wsA1 As Worksheet:      Set wsA1 = wbCMBO.Worksheets("SheetA1")
    Dim wsB2 As Worksheet:      Set wsB2 = wbCMBO.Worksheets("SheetB2")
    Dim wsS1 As Worksheet:      Set wsS1 = wbCMBO.Worksheets("Sheet1")
    Dim wsS2 As Worksheet:      Set wsS2 = wbCMBO.Worksheets("Sheet2")
    'Copy CSVs to Workbook Getline, and close CSVs
    Dim lr1 As Long:            lr1 = wsCSV1.UsedRange.Rows.Count
    Dim lr2 As Long:            lr2 = wsCSV2.UsedRange.Rows.Count
    Dim urA1AI As Range:        Set urA1AI = wsA1.Range("A1:I" & lr1)
    Dim urB2AI As Range:        Set urB2AI = wsB2.Range("A1:I" & lr2)
    wsA1.UsedRange.Cells.Clear: wsB2.UsedRange.Cells.Clear
    urA1AI.Value2 = wsCSV1.Range("A1:I" & lr1).Value2:       wbCSV1.Close False
    urB2AI.Value2 = wsCSV2.Range("A1:I" & lr2).Value2:       wbCSV2.Close False
    'AutoFilter and Copy
    wsS1.UsedRange.Cells.Clear: wsS2.UsedRange.Cells.Clear
    wsA1.UsedRange.AutoFilter Field:=5, Criteria1:="=*" & CRIT & "*"
    wsA1.UsedRange.AutoFilter Field:=8, Criteria1:=">0"
    wsA1.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=wsS1.Range("A1")
    wsB2.UsedRange.AutoFilter Field:=5, Criteria1:="=*" & CRIT & "*"
    wsB2.UsedRange.AutoFilter Field:=8, Criteria1:=">0"
    wsB2.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=wsS2.Range("A1")
    'Sort
    wsS1.UsedRange.Columns("A:I").Sort Key1:=wsS1.UsedRange.Columns("B"), Header:=xlNo
    wsS2.UsedRange.Columns("A:I").Sort Key1:=wsS2.UsedRange.Columns("B"), Header:=xlNo
End Sub

相关内容