VBA 编写代码 A表取数到B表，取数过程一部分数据处理

yaozhaoze

请各位老师好
  VBA 编写代码 从A表取数到B表，取数过程需要一部分数据处理，A标签数据不是固定的经常变动，B表需要根据A表运行VAB自动转换，数据大概5000行左右，每次数据都不一样。详细说明见附件，是否感谢各位老师帮忙.谢谢

ykcbf1100

说明够详细，但中间数据处理有点麻烦。

yaozhaoze

ykcbf1100 发表于 2024-1-9 14:47
说明够详细，但中间数据处理有点麻烦。

老师谢谢您帮忙，谢谢

yaozhaoze

ykcbf1100 发表于 2024-1-9 14:47
说明够详细，但中间数据处理有点麻烦。

之前有有个类似表，需要发给您看看嘛，之前用VBA录制制作的我感觉代码有点复杂，想请老师帮忙修改简易，，老师的表怎样发给您，可以加您微信吗？谢谢

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.9
   
2.     Dim arr, brr(1 To 10000, 1 To 26)
   
3.     arr = Sheets("A").UsedRange
   
4.     For i = 2 To UBound(arr)
   
5.         m = m + 1
   
6.         b = Split(arr(i, 19), "-")
   
7.         brr(m, 1) = b(0)
   
8.         brr(m, 2) = Format(b(1), "0000")
   
9.         brr(m, 6) = arr(i, 15)
   
10.         brr(m, 17) = arr(i, 11)
    
11.         brr(m, 18) = arr(i, 3)
    
12.         brr(m, 19) = brr(m, 18) + 10000
    
13.         st1 = CStr(Right(arr(i, 2), 2))
    
14.         st = Mid(arr(i, 10), 7)
    
15.         bb = Split(st)
    
16.         st2 = CStr(Val(Mid(bb(1), 3)))
    
17.         brr(m, 21) = st1 & " " & bb(0) & " " & st2 & " " & bb(2)
    
18.         brr(m, 24) = st1
    
19.     Next
    
20.     With Sheets("B")
    
21.         .UsedRange.Offset(1) = ""
    
22.         .Columns(2).NumberFormatLocal = "@"
    
23.         .Columns(24).NumberFormatLocal = "@"
    
24.         With .[a2].Resize(m, 24)
    
25.             .Value = brr
    
26.             .Borders.LineStyle = 1
    
27.             .HorizontalAlignment = xlCenter
    
28.             .VerticalAlignment = xlCenter
    
29.             .EntireColumn.AutoFit
    
30.         End With
    
31.     End With
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

ykcbf1100

你这数据处理要点力气的。

附件供参考。。。

yaozhaoze

ykcbf1100 发表于 2024-1-9 15:21
你这数据处理要点力气的。

附件供参考。。。

太感谢您了，我刚刚看了还有两个问题需要您帮忙修改代码，谢谢 U列 (供应商批次号)
1.“0.” 被去掉了。
2.执行VBA A表先排序，正序排序顺序（B列:(Packing No.）、J列:(Description)、 K列(Quantity) ）
3.保留5位数，不够5位前面用“0”补足5位（这个我刚写错了）

ykcbf1100

yaozhaoze 发表于 2024-1-9 16:14
太感谢您了，我刚刚看了还有两个问题需要您帮忙修改代码，谢谢 U列 (供应商批次号)
1.“0.” 被去掉了。 ...

已修改。。。

hhlty

Sub test()
    Dim ar, br, r, i, k
    k = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    With Sheet1.Sort
        .SortFields.Add Key:=Sheet1.Range("B2:B" & k)
        .SortFields.Add Key:=Sheet1.Range("J2:J" & k)
        .SortFields.Add Key:=Sheet1.Range("K2:K" & k)
        .SetRange Range("A1:T" & k)
        .Header = xlYes
        .Apply
    End With
    ar = Sheet1.[a1].CurrentRegion
    br = Sheet2.Range("A1:X" & k)
    Set r = CreateObject("vbscript.regexp")
    r.Pattern = "\x5b.+\x5d|\x28.+\x29|SQ|AWG|1X"
    r.Global = True
    For i = 2 To k
        br(i, 1) = Split(ar(i, 19), "-")(0)
        br(i, 2) = Format(Split(ar(i, 19), "-")(1), "00000")
        br(i, 6) = ar(i, 15)
        br(i, 17) = Int(ar(i, 11))
        br(i, 18) = ar(i, 3)
        br(i, 19) = Left(ar(i, 3), 4) + 1 & Right(ar(i, 3), 4)
        br(i, 21) = Right(ar(i, 2), 2) & " " & r.Replace(ar(i, 10), "")
        br(i, 24) = Right(ar(i, 2), 2)
    Next i
    Sheet2.Range("X2:X" & k).NumberFormatLocal = "@"
    Sheet2.[a1].Resize(k, 24) = br
End Sub

ykcbf1100

第1点不知道在哪里没改，其它改了。