求老师帮改 二维转一维表 增加个条件

jerry3770

求老师帮改 二维转一维表 增加个条件  万分感谢

ynzsvt

没看懂你的需求，建议做好需要的结果在另表显示。

liulang0808

liulang0808

表格格式跟结果调整了，供参考

jerry3770

liulang0808 发表于 2024-12-17 14:20
表格格式跟结果调整了，供参考

谢谢老师的解答，是我没表达清楚，附图说明我的需求，麻烦老师帮忙再改下   谢谢您了

liulang0808

jerry3770 发表于 2024-12-17 14:43
谢谢老师的解答，是我没表达清楚，附图说明我的需求，麻烦老师帮忙再改下   谢谢您了

楼主看下3楼截图，重新下载4楼附件看看

jerry3770

liulang0808 发表于 2024-12-17 14:20
表格格式跟结果调整了，供参考

谢谢老师，是我要的结果！祝您生活愉快

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.18
   
2.     With Sheets("原料")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a1].Resize(r, 6)
   
5.     End With
   
6.     ReDim brr(1 To 10000, 1 To 6)
   
7.     For i = 2 To UBound(arr)
   
8.         If InStr(arr(i, 1), "供应商") Then
   
9.             m = m + 1
   
10.             For j = 1 To 4
    
11.                 brr(m, j) = arr(i, j)
    
12.             Next
    
13.             brr(m, 5) = "日期"
    
14.             brr(m, 6) = "数量"
    
15.             rr = i
    
16.         Else
    
17.             For j = 5 To UBound(arr, 2)
    
18.                 m = m + 1
    
19.                 For x = 1 To 4
    
20.                     brr(m, x) = arr(i, x)
    
21.                 Next
    
22.                 brr(m, 5) = arr(rr, j)
    
23.                 brr(m, 6) = arr(i, j)
    
24.             Next
    
25.         End If
    
26.     Next
    
27.     With Sheets("原料转竖计划")
    
28.         .UsedRange.ClearContents
    
29.         .Columns(5).NumberFormatLocal = "m月d日"
    
30.         .[a1].Resize(m, 6) = brr
    
31.     End With
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码