一维表转二维表

nxxhswl

哪位大佬有时间看一下，将费用表内的数据按照2-支出项表的格式进行转换，

表内使用的sumifs函数。

Qs18

你这个有密码，想帮你都没有办法

nxxhswl

Qs18 发表于 2024-10-22 14:52
你这个有密码，想帮你都没有办法

抱歉，我的失误，忘记关闭工程密码了。

yanglinzi

你的结果表有两项费用表没有，不知到从哪里来的。

nxxhswl

yanglinzi 发表于 2024-10-22 15:24
你的结果表有两项费用表没有，不知到从哪里来的。

结果表是固定内容，在费用表里可能会没有，但其他月份会有，希望备注会与车牌号对应。
转换的时候不显示主卡和对应的数据。
也不显示现金加油。

lizhipei78

借题练习一下JSA

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, r&, c&, iPosRow&, iPosCol&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Worksheets(1).[A1].CurrentRegion.Value
    ReDim br(1 To UBound(ar), 1 To UBound(ar))
    r = 1: c = 1: br(1, 1) = "车牌号"
   
    For i = 2 To UBound(ar)
        If Not dic.exists(ar(i, 3)) Then
            r = r + 1
            dic(ar(i, 3)) = r
            br(r, 1) = ar(i, 3)
        End If
        If Not dic.exists(ar(i, 4)) Then
            c = c + 1
            dic(ar(i, 4)) = c
            br(1, c) = ar(i, 4)
        End If
        iPosRow = dic(ar(i, 3)): iPosCol = dic(ar(i, 4))
        br(iPosRow, iPosCol) = br(iPosRow, iPosCol) + ar(i, 5)
    Next i
   
    With Worksheets(2)
        .Cells.Clear
        With .[A1].Resize(r, c)
            .Value = br
            .Borders.LineStyle = xlContinuous
            .EntireColumn.AutoFit
        End With
        .Activate
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

nxxhswl

gwjkkkkk 发表于 2024-10-22 20:08
请参考。。。

多谢指导，明天学习一下。

nxxhswl

gwjkkkkk 发表于 2024-10-22 20:08
Option Explicit
Sub TEST6()
    Dim ar, br, i&, r&, c&, iPosRow&, iPosCol&, dic As Object

多谢，
功能已经实现了，
我想实现sumifs函数的效果，能否以sheet2的表头为字典，查找表1中出现的所有车牌号有关的费用和备注，表2中表头没有的字段名，可以不显示。