【求助】如何根据各客户的订单，依据基础数据汇总出各供应商的供应单

dsqbyf

客户订单

基础数据
目标表格

dsqbyf

这是根据各位老师的代码改的结果，哪位大神有时间帮忙优化一下

1.源数据图片预定单位及以后的列不是固定的为倒数非空的1/2/3/4列
2.目标工作表生成的数据不要源数据表最后一行的合计
3.采购单工作表能不能去掉读取供应商列表按钮，a2单元格下拉直接根据目标表格实现现在的效果

dsqbyf

数据透视表太麻烦了，还得删除多余列，有没有大神帮着看一下vba代码怎么弄

醉眼看尘世

睡不着，精神太好了，找点事儿干。。。附件中

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, vResult, i&, j&, r&, isFlag As Boolean
   
    Application.ScreenUpdating = False
   
    ar = Worksheets("数据基础表").[A1].CurrentRegion.Value
    br = Worksheets("源数据").[A1].CurrentRegion.Value
    ReDim vResult(1 To UBound(br), 1 To 4)
   
    For i = 2 To UBound(br) - 1
        r = r + 1
        vResult(r, 2) = br(i, 1)
        vResult(r, 3) = br(i, 13)
        vResult(r, 4) = br(i, 14)
        isFlag = False
        For j = 2 To UBound(ar)
            If ar(j, 2) = br(i, 1) Then
                vResult(r, 1) = ar(j, 1)
                isFlag = True
                Exit For
            End If
        Next j
        If isFlag = False Then vResult(r, 1) = "未指定供应商"
        
    Next i
   
    [A1].CurrentRegion.Clear
    [A1].Resize(, 4) = Array("供应商", "品名", "合计", "单位")
    [A2].Resize(r, UBound(vResult, 2)) = vResult
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

dsqbyf

醉眼看尘世 发表于 2024-10-4 02:42
睡不着，精神太好了，找点事儿干。。。附件中

厉害，谢谢大神

dsqbyf

gwjkkkkk 发表于 2024-10-4 08:23
Option Explicit
Sub TEST2()
    Dim ar, br, vResult, i&, j&, r&, isFlag As Boolean

谢谢老师，辛苦了，有时间给语句后边写个注释呗

dsqbyf

gwjkkkkk 发表于 2024-10-4 08:24
参与一下。。。

   ar = Worksheets("数据基础表").[A1].CurrentRegion.Value
这句引用的表格不对应该从商品数据里面寻找数据，不过还是谢谢老师了，数据基础表是以前用数据透视表筛出来的

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("源数据")
    Set sh = wb.Sheets("商品数据")
    arr = sht.[a1].CurrentRegion
    brr = sh.[a1].CurrentRegion
    ReDim crr(1 To UBound(arr) - 1, 1 To 4)
    For i = 2 To UBound(arr)
        crr(i - 1, 2) = arr(i, 1)
        crr(i - 1, 3) = arr(i, 13)
        crr(i - 1, 4) = arr(i, 14)
        s = arr(i, 1) & arr(i, 14)
        For j = 2 To UBound(brr)
            ss = brr(j, 5) & brr(j, 12)
            If s = ss Then crr(i - 1, 1) = brr(j, 11)
        Next
    Next
    With wb.Sheets("目标")
        .[a1].Resize(, 4) = [{"供应商名称","商品名称","合计","单位"}]
        .[a2].Resize(UBound(crr), 4) = crr
    End With
    Beep
End Sub