Excel VBA脚本中的对象定义错误

Excel VBA脚本中的对象定义错误,vba,excel,excel-2013,Vba,Excel,Excel 2013,我试图构建一个脚本,提取列(用户定义)的前6个字符,然后插入一个新列并粘贴这些结果,或者只是将这些结果放在一个已经存在的列上(用户选择),但我一直遇到一个对象定义错误(我在代码中用星号标记了行) 谁能告诉我我做错了什么?这是我的密码 Sub AAC_Extract() Dim rng As Range, col As Range, arr Dim sht As Worksheet, shet As Worksheet On Error Resume Next

我试图构建一个脚本,提取列(用户定义)的前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

很可能
sht
为空

您可以
将sht设置为工作表,但决不能
将其设置为任何值。您的错误行是使用
sht
的第一行,因此它恰好是引起您注意错误的地方

如果您希望将其设置为与
dest
范围相关联的工作表,则我会这样做

set sht = dest.Worksheet

在处理<代码> CLS时,您需要小心不要重用该变量(尽管您可能会考虑重命名那些对它们正在做的事情更加明确,但这是另一回事)。在设置

dest
rng
时,不能保证它们来自同一张表,这会在设置
col
cols
时产生问题。如果您试图在不同的工作表上用单元格组成一个区域,您会遇到一个例外。

在相关说明中,您可以使用VBA将最左边的六个字符快速放入一整列,方法是选择宽度为6的第一个字段,然后丢弃任何其他字段。对于值的长列,这将在循环和拉出每个单元格的前六个字符方面产生明显的差异

在所提供代码的底部附近,有以下循环

    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传输到col,然后立即删除所有超过第六个字符的内容

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

代码段实现:

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

我看不到任何
*
哪一行给你添麻烦了?@Brad对不起,关于这一点。我编辑了脚本以显示星号。我想不出还有什么别的办法,除了我把它注释掉的方式。我想如果我能解决这部分问题,我就能为其他3个布尔人编写代码。谢谢你提供的信息。老实说,我并不完全理解这些,但我会一直重读,直到我理解为止。我添加了set sht=dest.worksheet,它使我越过了我所停留的点。现在它在最后一部分给了我一个错误:对于col.Cells中的每个c.Value=Left(Cells(i,cols.column),6)下一个c,你知道为什么我不能使用这个语法吗?我将cols设置为一个范围,并选择I和范围cols的列数,对吗?或者我误解了。语法看起来不错……您是否使用调试器查看了
cols.column
的值?它指的是哪张纸?使用局部变量和观察窗口了解变量的值。请记住,
单元格
在不引用工作表的情况下使用时(例如:
工作表(1)。单元格(i,cols.Column)
将引用活动工作表中的一个范围。绕过此范围称为使用完全限定引用。每个范围对象(
范围
单元格
)是工作表的子对象。您希望尽可能明确地说明什么工作表是父工作表。不要让Excel替您决定。@flwr_pwr这里有一个例子,说明了我所说的“设置dest和rng的方式不能保证它们来自同一个工作表,这在设置col和cols时会导致问题”:
Set dest=Sheets(1).Range(Sheets(2).Cells(1,1),Sheets(1).Cells(2,3))
这将引发异常“应用程序定义或对象定义错误”。该错误是有意义的,因为您试图从两张不同的工作表上的单元格组成一个连续范围。这样做并不符合逻辑。非常感谢您的解释!我现在真的理解了您的意思,并且我现在理解了.Parent函数。我正在查看本地窗口,并在调试代码时观察窗口。希望这我将提供一些关于它出错原因的见解!很有趣。我尝试使用了您提供的方法;但是,在插入新列后,宏似乎没有任何作用。您对原因有什么想法吗?我已经更新了原始文件中的代码Post@flwr_pwr-我已将该代码段添加到完整更新的代码中太好了!非常感谢。非常有效。如果你不介意的话,你能解释一下代码的这一部分吗?'FieldInfo:=Array(Array(0,1),Array(6,9))'我之所以这么问,是因为我还需要重新创建函数来提取范围的中间(7,4),然后“我希望使用相同的方法。不幸的是,在我仔细阅读了您提供的语法字符串之后,我已经不知所措了。我包括了一个到官方文档的链接。如果您在概念上遇到问题,为什么不从那里开始,然后带着具体问题回来呢?可以。谢谢您的帮助!