Я получаю ошибку выполнения 1004 для «Application Defined ... 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
Я пытался сделать ваш код более управляемым, но он не тестировался.
Это основано на 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