Excel VBA腳本中的對象定義錯誤

Question

我在嘗試構建一個腳本，該腳本可提取列（用戶定義的）的前6個字符，並插入一個新列並粘貼這些結果，或者只是將這些結果通過已存在的結果列（用戶的選擇），但我不斷收到一個對象定義錯誤（我用星號標記了代碼中的行）。

誰能告訴我我做錯了什麼？這裏是我的代碼

Sub AAC_Extract() 
    Dim rng As Range, col As Range, arr 
    Dim sht As Worksheet, shet As Worksheet 

    On Error Resume Next 
    Set rng = Application.InputBox(_ 
       Prompt:="Please select the column that contains the Standard Document Number. " & vbNewLine & _ 
         " (e.g. Column A or Column B)", _ 
       Title:="Select Document Number Range", Type:=8) 
    On Error GoTo 0 
    hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option") 

    Set dest = Application.InputBox(_ 
       Prompt:="Please select the column that you would the AAC to be placed in. " & vbNewLine & _ 
         " (e.g. Column B or Column C)", _ 
       Title:="Select Destination Range", Type:=8) 

    If dest Is Nothing Then Exit Sub 
    Set sht = dest.Worksheet 
    Set shet = rng.Worksheet 
    'If dest = rng Then 
    ' MsgBox "Your Destination Range can not be the same as your Reference Range. Please choose a valid Destination Range", vbExclamation 
    ' Exit Sub 
    'End If 


    On Error GoTo 0 
    yn = MsgBox("Do you want to insert a new column here?" & vbNewLine & _ 
         "(Choosing 'No' will replace the current cells in your selected range." & vbNewLine & "All data in this range will be permanently deleted.)", vbYesNo + vbQuestion, "Destination Range Options") 


    LastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 

    Application.ScreenUpdating = False 
    If hdr = vbYes And yn = vbYes Then 
     dest.Select 
     With Selection 
     .EntireColumn.Insert 
     End With 
     Set col = sht.Range(sht.Cells(2, dest.Column), _ 
         sht.Cells(sht.Rows.Count, dest.Column).End(xlUp)) 
     Set cols = shet.Range(shet.Cells(2, rng.Column), _ 
         shet.Cells(shet.Rows.Count, rng.Column).End(xlUp)) 
     'Columns = cols.Column 
     'dest.EntireColumn.Insert 
     'col = dest.Column 
     'cols = rng.Column 
     'For i = 1 To LastRow 
     'Cells(i, col).Value = Left(Cells(i, cols), 6) 
     'Next i 
     'For Each c In col.Cells.Offset(0, -1) 'Offset due to the fact that dest moved when a column was inserted 
     ' i = c.Row 
     ' c.Value = Left(cols.Cells(i - 1), 6) 'Honestly, I'm not sure why I have to subtract 1 from i....i should be the same row as c 
     'Next c 
     With col 
     .Value2 = cols.Value2 
     .TextToColumns Destination:=.Cells, DataType:=xlFixedWidth, _ 
     FieldInfo:=Array(Array(0, 1), Array(6, 9)) 
     End With 
    End If 

End Sub 

Answer 1

很可能sht爲空。

你Dim sht as Worksheet但從來沒有Set它到任何東西。您的錯誤行是使用sht的第一行，因此恰好是錯誤引起您注意的地方。

我會瘦你想要將它設置到與dest範圍相關聯的工作表。

set sht = dest.Worksheet 

與cols打交道時，你必須要小心不要重複使用變量，但（你可以考慮重命名這些更明確的瞭解他們在做什麼，但是那是另一回事）。按照您設置dest和rng的方式，它們不能保證來自相同的表格，這會在設置col與cols時產生問題。如果您嘗試使用不同工作表上的單元格組合範圍，則會發生異常。

Answer 2

在一個相關的說明，您可以非常快速地使用VBA的TextToColumn method，選擇的第一個字段作爲的寬度和丟棄任何其他領域獲得的六個最左側的字符轉換成整列。對於較長的值列，這應該在循環和拉出每個單元格的前六個字符方面產生顯着的差異。

在您提供的代碼的底部附近，您有以下循環。

For Each c In col.Cells 
     c.Value = Left(Cells(i, cols), 6) 
    Next c 

這似乎有COL定義爲前六個字符的從源列COLS 目的地。你循環遍歷每個單元格，並揭開前六個字符。

With col 
    .Value2 = cols.Value2 
    .TextToColumns Destination:=.Cells, DataType:=xlFixedWidth, _ 
     FieldInfo:=Array(Array(0, 1), Array(6, 9)) 
End With 

這從傳輸的cols值到山坳剝掉任何過去的第六個字符一路經柱一次。

對於小於幾百個值的任何東西，我不知道是否會打擾重寫，但效率會增加需要處理的更多行值。

片段實施：

Sub AAC_Extract() 
    Dim rng As Range, col As Range, cols As Range, arr 
    Dim sht As Worksheet, shet As Worksheet, hdr As Long, yn As Long, LastRow As Long 
    Dim dest As Range 

    On Error Resume Next 
    Set rng = Application.InputBox(_ 
       Prompt:="Please select the column that contains the Standard Document Number. " & vbNewLine & _ 
         " (e.g. Column A or Column B)", _ 
       Title:="Select Document Number Range", Type:=8) 
    On Error GoTo 0 
    hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option") 

    Set dest = Application.InputBox(_ 
       Prompt:="Please select the column that you would the AAC to be placed in. " & vbNewLine & _ 
         " (e.g. Column B or Column C)", _ 
       Title:="Select Destination Range", Type:=8) 

    If dest Is Nothing Then Exit Sub 
    Set sht = dest.Parent 
    Set shet = rng.Parent 

    On Error GoTo 0 
    yn = MsgBox("Do you want to insert a new column here?" & vbNewLine & _ 
       "(Choosing 'No' will replace the current cells in your selected range." & vbNewLine & _ 
       "All data in this range will be permanently deleted.)", vbYesNo + vbQuestion, "Destination Range Options") 


    LastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 

    Application.ScreenUpdating = False 
    If yn = vbYes Then 
     dest.EntireColumn.Insert 
     Set dest = dest.Offset(0, -1) 
    End If 

    'I'm not sure about this because the next set starts in row 2 regardless 
    'If hdr = vbYes Then 
    ' Set dest = dest.Resize(dest.Rows.Count - 1, 1) 
    'End If 

    Set cols = shet.Range(shet.Cells(2, rng.Column), _ 
        shet.Cells(shet.Rows.Count, rng.Column).End(xlUp)) 
    Set col = sht.Cells(2, dest.Column).Resize(cols.Rows.Count, 1) 

    With col 
     .Value2 = cols.Value2 
     .TextToColumns Destination:=.Cells, DataType:=xlFixedWidth, _ 
      FieldInfo:=Array(Array(0, 1), Array(6, 9)) 
    End With 

End Sub