Question

我正在尝试构建一个脚本，用于提取列的前6个字符（用户定义），并插入新列并粘贴这些结果，或者只是将这些结果粘贴到现有列上（User＆＃39 ; s选择）但我不断得到一个对象定义错误（我用星号标记了代码中的行）。

谁能告诉我自己做错了什么？这是我的代码

 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快速将六个最左边的字符放入整个列中，选择第一个字段作为 6 的宽度并丢弃任何其他领域。对于长列值，这应该在循环和拉出每个单元格的前六个字符方面产生明显的差异。

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

NULL

这似乎将 col 定义为源列 cols 中前六个字符的目标。你遍历每个单元格并剥离前六个字符。

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

这会将值从 cols 传输到 col ，然后立即从列中删除任何超过第六个字符的内容。

对于少于几百个值的任何东西，我不知道我是否会为重写而烦恼，但效率会增加你必须处理的更多行值。

代码段实施：

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

Excel VBA脚本

2 个答案: