Я получаю сообщение об ошибке 1004 для "Application Defined ... Определено»

и с некоторыми настройками форматирования

Я получаю сообщение об ошибке 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 ответ1

0

Я пытался сделать ваш код немного более управляемым, но он не тестировался

Это зависит от 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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .