求大神帮忙写个vba代码—关于数据分列及组合

兰妞

求大神帮忙写个vba代码，（我可能没有讲清楚，每一行代表一个订单号，客户可能买的东西是多个装，用分隔符号分隔开来，*数量代表的是同个商品编码买的数量，例如R65-Gold * 3;R65-White * 3;R65-Red * 3,需要计算这个客户购买的这些产品的总成本是多少=R65-Gold成本*3+R65-White*3+R65-Red *3，但是匹配成本表的时候只能是*号前面的编码去匹配。）


想要将表格里的“Sheet1” O列的商品编码复制到新的工作表“5”的A列中，先用分隔符号“;”分列数据，分裂后的数据需要再用分隔符号“*”分列，分列后的数据需要清空前后空字符串，再用vlookup函数匹配“成本”表里的成本，如若匹配不上则显示为空值，再依次分列B列、C列、E列的编码数量（因为数据量大，有可能会比E列多，最多不超10列数），最后分列好的数据，匹配成本后，乘以数量，再加上同一行其他列的编码成本乘以数量。
麻烦大神帮忙看看这个问题~~~~

ykcbf1100

没看明白啊。取值到5表，这个没问题，但是，再到成本表vlookup一下，取的是啥值？不是应该是价格吗？

兰妞

ykcbf1100 发表于 2024-5-21 19:55
没看明白啊。取值到5表，这个没问题，但是，再到成本表vlookup一下，取的是啥值？不是应该是价格吗？

可能我没有解释清楚，就是取值到“5”表，但是有的客户一个订单买多个产品，商品编码用分隔符号分隔开来了，需要用分隔符号分列开，*后面代表的是数量，这样才能用商品编码去匹配成本表里的价格，匹配后的价格需要乘以数量，如果买了多个装的话，要加上后面分列的编码总成本价格

wang-way

你自己把问题想得很复杂 你不用告诉别人怎么编程 你告诉别人要什么结果可能好一点

ykcbf1100

兰妞 发表于 2024-5-21 19:58
可能我没有解释清楚，就是取值到“5”表，但是有的客户一个订单买多个产品，商品编码用分隔符号分隔开来 ...

你做个效果图呗。

gwjkkkkk

Option Explicit
Sub TEST7()
    Dim ar, br, cr$(), dr$(), i&, j&, k&, n&, dic As Object, iColSize&, t#
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    t = Timer
   
    ar = Sheets(1).Range("O2", Sheets(1).Cells(Rows.Count, "O").End(xlUp)).Value

    br = Sheets(2).[A1].CurrentRegion.Value
    For i = 2 To UBound(br)
        dic(br(i, 1)) = br(i, 2)
    Next i
   
    ReDim br(1 To UBound(ar), 1 To 20)
    For i = 1 To UBound(ar)
        n = 0
        cr = Split(ar(i, 1), ";")
        If (UBound(cr) + 1) * 2 > iColSize Then iColSize = (UBound(cr) + 1) * 2
        For j = 0 To UBound(cr)
            dr = Split(cr(j), " * ")
            n = n + 1
            br(i, n) = dr(0)
            If Not dic.exists(dr(0)) Then
                n = n + 1
                br(i, n) = Empty
            Else
                n = n + 1
                br(i, n) = dic(dr(0)) * dr(1)
            End If
        Next j
    Next i
   
    With Sheets(3)
        .Cells.Clear
        With .[A1].Resize(UBound(br), iColSize)
            .Value = br
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .EntireColumn.AutoFit
        End With
        .Activate
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

.................

wang-way

不求效率 只求结果

1. Sub MatchData()
   
2.     Dim Wb As Workbook
   
3.     Dim Sht As Worksheet
   
4.     Dim d As Object
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.                     
   
7.     Set Wb = Application.ThisWorkbook
   
8.     Set Sht = Wb.Worksheets("成本")
   
9.     With Sht
   
10.         endrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.         For i = 2 To endrow
    
12.             d(.Cells(i, 1).Value) = .Cells(i, 2).Value '读取编号 成本
    
13.         Next i
    
14.     End With
    
15.     Set Sht = Wb.Worksheets("Sheet1")
    
16.     With Sht
    
17.         For i = 2 To endrow
    
18.             mysum = 0
    
19.             s = .Cells(i, "o").Value
    
20.             ar1 = Split(s, ";") '拆分编码
    
21.             For Each a1 In ar1
    
22.                    ar2 = Split(a1, " * ") '拆分编码 数量
    
23.                    mysum = mysum + d(ar2(0)) * ar2(1)
    
24.             Next a1
    
25.             .Cells(i, "ak").Value = mysum
    
26.         Next i
    
27.     End With
    
28. End Sub

复制代码

shiruiqiang

ykcbf1100 发表于 2024-5-21 20:09
你做个效果图呗。

应该这个意思

兰妞

gwjkkkkk 发表于 2024-5-21 20:20
.................

大神，感谢你，实在太厉害啦。但是可以加多一步吗，能把他们同行的每一列相加起来吗？，只是要总的成本数值