[已解决]请在下面代码增加arr和转置函数

hcy1185 · 发表于 2012-12-25 13:58

本帖最后由 hcy1185 于 2012-12-25 14:04 编辑

Sub 标题写入字典再填到单元格()
Dim d As Object, lie As Integer, j As Integer
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
lie = Range("IV1").End(xlToLeft).Column
For j = 1 To lie
d(Cells(1, j).Value) = Cells(1, j)
Next j
Sheet2.Range("a1").Resize(1, d.Count) = d.keys 'd.items
Set dic = Nothing 'd.RemoveAll
End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-12-25 14:42

Sub 标题写入字典再填到单元格()
Dim d As Object, lie As Integer, j As Integer
Dim arr
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
arr = Range(Cells(1, Range("IV1").End(xlToLeft).Column), Range("iv1"))
For j = 1 To UBound(arr, 2)
d(arr(1, j)) = arr(1, j)
Next j
'一列输出
Sheet2.Range("a1").Resize(d.Count, 1) = Application.Transpose(d.keys)
'一行输出
'Sheet2.Range("a1").Resize(1, d.Count) = d.keys
Set d = Nothing 'd.RemoveAll
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2012-12-25 14:07

神马情况？
application.transpose()
转置。

hcy1185 · 发表于 2012-12-25 14:15

hwc2ycy 发表于 2012-12-25 14:07
神马情况？
application.transpose()
转置。

如果把
sheet1.range("a1:a" & lie)写入arr
现在的代码如何修改?
谢谢!!!

hwc2ycy · 发表于 2012-12-25 14:28

arr = Sheet1.Range("a1:a" & ie)

hcy1185 · 发表于 2012-12-25 14:32

hwc2ycy 发表于 2012-12-25 14:28
arr = Sheet1.Range("a1:a" & ie)

d(Cells(1, j).Value) = Cells(1, j)
怎么修改?

hwc2ycy · 发表于 2012-12-25 14:34

d(arr(1,j))=arr(1,j)

hwc2ycy · 发表于 2012-12-25 14:42

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub 标题写入字典再填到单元格()
Dim d As Object, lie As Integer, j As Integer
Dim arr
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
arr = Range(Cells(1, Range("IV1").End(xlToLeft).Column), Range("iv1"))
For j = 1 To UBound(arr, 2)
d(arr(1, j)) = arr(1, j)
Next j
'一列输出
Sheet2.Range("a1").Resize(d.Count, 1) = Application.Transpose(d.keys)
'一行输出
'Sheet2.Range("a1").Resize(1, d.Count) = d.keys
Set d = Nothing 'd.RemoveAll
End Sub

复制代码

		自动登录	找回密码
密码			注册

[已解决]请在下面代码增加arr和转置函数

相关帖子