分类导航

程序问答发布时间：2022-06-02 发布网站：大佬教程 code.js-code.com

大佬教程收集整理的这篇文章主要介绍了应用程序定义或对象定义错误 - 调整 Ubound、Application.Transpose，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

如何解决应用程序定义或对象定义错误 - 调整 Ubound、Application.Transpose？

开发过程中遇到应用程序定义或对象定义错误 - 调整 Ubound、Application.Transpose的问题如何解决？下面主要结合日常开发的经验，给出你关于应用程序定义或对象定义错误 - 调整 Ubound、Application.Transpose的解决方法建议，希望对你解决应用程序定义或对象定义错误 - 调整 Ubound、Application.Transpose有所启发或帮助；

我遇到了我们为特定任务编写的小代码的问题。简而言之，任务是获取两列的输入； (A) 包含具有产品编号（和重复项）的行，以及 (B) 包含该特定产品编号的相应值。

我们希望在 A 列中拥有一个 UNIQUE productnumber，而在 B 列中拥有相应的（连接的）值，而不是 100.000 行。这已经实现了。

我在堆栈中找到了这里的大部分代码并对其进行了一些更改。很想链接，但不记得我从哪里得到的 - 抱歉！现在，我们有很多行，因此原始代码遇到了问题，因为循环变量 (i) 变暗为整数。

为了解决这个问题，我迅速将其更改为 Long 类型。但是，这给我带来了另一个问题：“运行时错误‘1004’：应用程序定义或对象定义的错误”

调试告诉我是下面的注释部分提出了一个问题，但我无法修复它。

非常感谢任何帮助。在此先感谢您！！

Option Explicit

Sub groupConcat()
Dim dc As Object
Dim inputArray As Variant
Dim i As Long
Dim lastRow As Long

获取最后一行

lastRow = Range("A" & Rows.Count).End(xlUp).Row

将 E 格式化为文本

Range("E1:E20000").numberFormat = "@"

在完成任何进一步的工作之前清除工作表

Worksheets("Sheet1").Range("D2:E20000").ClearContents
Set dc = CreateObject("ScripTing.Dictionary")
inputArray = WorksheetFunction.Transpose(Sheets(1).Range("A2:B" & lastRow).value)

   '-- assuming you only have two columns - otherwise you need two loops
   For i = LBound(inputArray,2) To UBound(inputArray,2)
        If Not dc.Exists(inputArray(1,i)) Then
            dc.Add inputArray(1,i),inputArray(2,i)
        Else
            dc.Item(inputArray(1,i)) = dc.Item(inputArray(1,i)) _
            & "," & inputArray(2,i)
        End If
   Next i

'--output into sheet
Sheets(1).Range("D2").Resize(UBound(dc.keys) + 1) = _
          Application.Transpose(dc.keys)

问题如下

Sheets(1).Range("E2").Resize(UBound(dc.items) + 1) = _
          Application.Transpose(dc.items)

Set dc = nothing

End Sub

解决方法

也许是双转置。试试这个版本，看看它是否适合你：

    Sub DictMatch()
        Dim arr,j As Long,Dict As Object
        arr = Sheet1.Range("A1").CurrentRegion.Value2 'load source
        Sheet1.Range("A1").CurrentRegion.ClearContents
        Set Dict = CreateObject("ScripTing.Dictionary") 'create Dictionary lateB
        With Dict 'used because I'm to lazy to retype Dict everywhere :)
            
            For j = 1 To UBound(arr) 'traverse source
                If Not .Exists(arr(j,1)) Then 'set key if I don't have it yet in Dict
                    .Add Key:=arr(j,1),Item:=arr(j,2)
                Else
                    Dict(arr(j,1)) = Dict(arr(j,1)) & "," & arr(j,2)
                End If
                Debug.Print arr(j,Dict(arr(j,1))
            Next j
        End With
        
        With Sheet1 'dump target array to sheet
            .Cells(1,1).Resize(Dict.Count,1).Value2 = Application.Transpose(Dict.keys)
            .Cells(1,2).Resize(Dict.Count,1).Value2 = Application.Transpose(Dict.Items)
        End With
    End Sub