自动生成表格

清风竹-

whmomo 发表于 2024-2-27 11:07
非常感谢！！
如果在第2列加一个代码描述，程序要怎么更改啊？

Sub 生成表格()
arr = Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To 4)
For i = 3 To UBound(arr, 2)
    For j = 2 To UBound(arr)
        If arr(j, i) > 0 Then
            n = n + 1
            brr(n, 1) = arr(1, i)
            brr(n, 2) = arr(j, 1)
            brr(n, 3) = arr(j, 2)
            brr(n, 4) = arr(j, i)
       End If
    Next
Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
Cells(1, 1).Resize(n, 4) = brr
End Sub

whmomo

清风竹- 发表于 2024-2-27 12:20
arr = Range("a1").CurrentRegion '把与A1单元格有数据相连的矩形区域的数装入数组arr
ReDim brr(1 To U ...

不好意思，更改几次程序后还是实现的效果不对，麻烦再指教一下，谢谢！

whmomo

清风竹- 发表于 2024-2-27 12:20
Sub 生成表格()
arr = Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To ...

感谢，可以正常运行

whmomo

清风竹- 发表于 2024-2-27 12:20
Sub 生成表格()
arr = Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To ...

如果由【sheet1】和【计划】2个表自动生成sheet2的表格数据，里面我用公式写的，能不能也自动生成表格呢？

清风竹-

whmomo 发表于 2024-2-28 18:27
如果由【sheet1】和【计划】2个表自动生成sheet2的表格数据，里面我用公式写的，能不能也自动生成表格呢 ...

请看附件。

whmomo

清风竹- 发表于 2024-2-28 20:41
请看附件。

我在sheet1中增加了一列，然后程序也更改了，但是点生成表格后把3月1号的没有了，直接从3月2号开始了，看一下程序是哪个地方没有更改到位

Sub 生成表格()
arr = Range("a1").CurrentRegion
crr = Sheets("计划").Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To UBound(crr, 2) + 2)
  n = 1
Set d = CreateObject("scripting.dictionary")
  For i = 2 To UBound(crr)
      For j = 3 To UBound(crr, 2)
         crr(1, j) = Format(crr(1, j), "yyyy" & "/" & "m" & "/" & "d")
          If crr(i, j) > 0 And crr(1, j) <> "" Then
             ss = crr(i, 1) & crr(1, j)
             d(ss) = crr(i, j)
          End If
      Next
  Next
  For j = 3 To UBound(crr, 2)
      brr(1, j + 2) = crr(1, j)
  Next
  
For i = 4 To UBound(arr, 2)
    For j = 2 To UBound(arr)
        If arr(j, i) > 0 Then
            n = n + 1
            brr(n, 1) = arr(1, i)
            brr(n, 2) = arr(j, 1)
            brr(n, 3) = arr(j, 2)
            brr(n, 4) = arr(j, 3)
            brr(n, 5) = arr(j, i)
            For x = 6 To UBound(brr, 2)
               ss = brr(n, 1) & brr(1, x)
               If d.Exists(ss) Then
                  brr(n, x) = d(ss) * brr(n, 5)
               End If
            Next
            
       End If
    Next
Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
Range("F1:AJ1").NumberFormatLocal = "m" & "月" & "d" & "日"
Cells(1, 1).Resize(n, UBound(crr, 2) + 2) = brr
Cells(1, 1).Resize(1, 5) = Array("总代码", "代码", "代码描述", "代码描述2", "用量")

End Sub

如果再在生成的表格中添加一个【汇总】按钮，点击后按"代码", "代码描述", "代码描述2"，后面是每个日期的汇总，生成一个新的表就完好了

清风竹-

whmomo 发表于 2024-2-29 12:39
我在sheet1中增加了一列，然后程序也更改了，但是点生成表格后把3月1号的没有了，直接从3月2号开始了，看 ...

请看附件。生成汇总是什么样式的，上附件或图。

whmomo

清风竹- 发表于 2024-2-29 16:24
请看附件。生成汇总是什么样式的，上附件或图。

麻烦有时间看一下附件，谢谢

清风竹-

whmomo 发表于 2024-2-29 17:31
麻烦有时间看一下附件，谢谢

请看附件。

Holiday2022

quqiyuan 发表于 2024-2-26 10:27
你想能自动更新的话，估计PQ比较合适

今天没花了，不然我肯定给你，为的就是Power Query。本题用Power Query解决，逆透视列就好了，非常简单。