[已解决]EXCEL VBA 类似转置功能如何写，求助！

gemeng25569

hasyh2008 发表于 2022-6-20 16:30
人员，月份不受限。

hasyh2008，你好，不好意思可能我表达的不太清楚，名字和编号内容不用去更新过去，只更新对应的ABCD即可，日期更新和不更新都可以
附件图片有我原表的截图，其它列数据都是不变的，根据《seet数据》表里的编号，把对应的ABCD填到《sheet结果》相同编号和日期单元格中

hasyh2008

Sub 汇总()    On Error Resume Next   
Dim D    Dim R%, C%, Arr, Brr   
Set D = CreateObject("scripting.dictionary")   
Arr = Sheet1.Range("A1").CurrentRegion   
For R = 2 To UBound(Arr)      
D(Arr(R, 2) & Arr(R, 3) & Arr(R, 1)) = Arr(R, 4)  
Next R   
Brr = Sheet2.Range("A2:H10")   
For R = 2 To UBound(Brr)        
For C = 3 To UBound(Brr, 2)            
Brr(R, C) = D(Brr(R, 1) & Brr(R, 2) & Brr(1, C))      
  Next C  
  Next R  
  Sheet2.Range("A2").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End Sub

hasyh2008

再试试

林木水

gemeng25569 发表于 2022-6-21 13:42
谢谢你，报错截图在附件中，再帮看看

用公式是我想要的结果，根据 日期 编号 名字算出对应的ABCD，就 ...

我猜可能是版本问题，你把后面哪条改成公式+格式试一下
.Range("c2").Resize(d2.Count, d1.Count).PasteSpecial (xlPasteFormulasAndNumberFormats)

gemeng25569

林木水 发表于 2022-6-22 09:05
我猜可能是版本问题，你把后面哪条改成公式+格式试一下
.Range("c2").Resize(d2.Count, d1.Count).Paste ...

还是报错哦

gemeng25569

林木水 发表于 2022-6-22 09:05
我猜可能是版本问题，你把后面哪条改成公式+格式试一下
.Range("c2").Resize(d2.Count, d1.Count).Paste ...

而且处理上千条数据时特别的卡，有没有更好的方法呢？

gemeng25569

hasyh2008 发表于 2022-6-21 19:04
再试试

hi hasyh2008，最近请假没有及时来处理这个问题现在这个效果真的很厉害，就是我初学能力有限，能不能帮忙把代码注译一下，不然引用这代码很吃力，好多都看不明白，非常感谢

我行我速2008

Sub 汇总()
    On Error Resume Next
    Dim D
    Dim R%, C%, Arr, Brr
    Set D = CreateObject("scripting.dictionary")                   '创建字典
    Arr = Sheet1.Range("A1").CurrentRegion                         '数组A引用表一单元格区域
    For R = 2 To UBound(Arr)
       D(Arr(R, 2) & Arr(R, 3) & Arr(R, 1)) = Arr(R, 4)             '以表一中第2列、第3列、第1列的字符串作为字典的KEY，以第4列的值为字典的ITEM
    Next R
    Brr = Sheet2.Range("A2:H10")                                    '数组B引用表二单元格区域
       For R = 2 To UBound(Brr)
           For C = 3 To UBound(Brr, 2)
           Brr(R, C) = D(Brr(R, 1) & Brr(R, 2) & Brr(1, C))         'C2：H10的每个单元格都在查找自己对应的编号、姓名及日期的ITEM，找到后填在数组B的对应位置。
      Next C
    Next R
    Sheet2.Range("A2").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End Sub

处理表格数据，数组和字典最常用，且速度非常快，建议在这两个方面多学习，蓝版的字典以及兰版的VBA80讲值得拥有。