代码失效了

divineson

一直能使用的代码不能使用了，不知是否和C列的文字格式有关系，红字部分就是报错的地方，请各位老师帮忙看看，万分感谢！



Sub 转置()
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
t = arr(i, 1)
If d.exists(t) Then
   d(t) = Array(arr(i, 1), arr(i, 2), d(t)(2) & "、" & arr(i, 3))
Else
   d(t) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
End If
Next i
Z = d.items
Z = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Z))
[f2].Resize(UBound(Z), UBound(Z, 2)) = Z
End Sub

ykcbf1100

我这里没有问题

win11+office2021

divineson

ykcbf1100 发表于 2024-11-14 13:27
我这里没有问题

win11+office2021

难道是版本问题，单位是Win10+13版的office，一运行就显示“类型不匹配”，运行错误13

loirol

win10+365测试通过

蓝桥玄霜

我测试是正常的。不过我的写法是：

divineson

蓝桥玄霜 发表于 2024-11-14 13:46
我测试是正常的。不过我的写法是：

蓝老师你好，按照你的方法重写后，前两列有显示了，但C列还是没能显示出来，显示“1004，程序定义或对象定义错误”，断点在倒数第二行（End sub，这行不算），不知道是不是真的版本问题！

ykcbf1100

换个写法，各版本通用

ykcbf1100

换个写法。。。

1. Sub ykcbf()    '//2024.11.14
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Range("a1").CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To 3)
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         If d.exists(s) Then
   
8.             r = d(s)
   
9.             brr(r, 3) = brr(r, 3) & "、" & arr(i, 3)
   
10.         Else
    
11.             m = m + 1
    
12.             d(s) = m
    
13.             For j = 1 To UBound(arr, 2)
    
14.                 brr(m, j) = arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next i
    
18.     [f2].Resize(m, 3) = brr
    
19. End Sub
    
20. 
    

复制代码

autohotey

你说的是Sheet2表里进行转置报错“类型不匹配”吧？      
因为表2没有数据，Transpose至少需要一行/一列数组，所以会报类型不匹配

micch

在输出前，先判断字典有多少内容，items不是数组的话，是不能tranpose的