ข้อผิดพลาด“ แอปพลิเคชันที่กำหนดหรือวัตถุที่กำหนด” ข้อผิดพลาด '1004 "


0

ฉันได้รับข้อผิดพลาด runtime 1004 สำหรับ "Application Defined ... Defined"

และมีการปรับการจัดรูปแบบบางอย่าง

ฉันได้รับข้อผิดพลาดรันไทม์ 1004 "การอ้างอิงการเรียงลำดับไม่ถูกต้องตรวจสอบให้แน่ใจว่ามันอยู่ในข้อมูลที่คุณต้องการเรียงลำดับและกล่อง Sort By แรกไม่เหมือนหรือว่างเปล่า"

ฉันมีความรู้ จำกัด ว่าทำไมฉันถึงได้รับข้อผิดพลาดนี้จำกัดความรู้เกี่ยวกับการเขียนโค้ด 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

ดูเหมือนจะไม่มีแถวสุดท้ายในช่วงของคุณช่วง ("A2: I")
QHarr

คำตอบ:


0

ฉันพยายามทำให้โค้ดของคุณจัดการได้ง่ายขึ้น แต่ยังไม่ผ่านการทดสอบ

สิ่งนี้ต้องอาศัย UsedRange ดังนั้นให้ลบแถวที่ว่างเปล่าทั้งหมดออกจาก Combo.xlsm บนแผ่นงานทั้งหมด

ในการพิจารณาว่าคุณมีแถวว่างหรือไม่ในแต่ละเซลล์เลือกแผ่นงาน A1จากนั้นกด Ctrl + ปลาย


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

ขอบคุณฉันจะตรวจสอบในวันนี้และเปลี่ยนไปใช้เวอร์ชัน "ปรับ" นี้ (ไม่แน่ใจว่าเป็นคำที่ถูกต้อง) ฉันเห็นว่าฉันมีอะไรต้องเรียนรู้มากมายขอบคุณ!
Loading...

ดูเหมือนว่าจะทำเคล็ดลับ ฉันไม่แน่ใจว่าปัญหามาจากที่ใด ว้าวขอบคุณ! ชื่นชมมาก
Loading...
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.