数据转换

sampsonpon

具体要求如下

demonimissyou

数组+循环+split+trim就能搞定

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim reg As New RegExp
   
5.     With reg
   
6.         .Global = True
   
7.         .Pattern = "^0+"
   
8.     End With
   
9.     With Worksheets("t113")
   
10.         r = .Cells(.Rows.Count, 9).End(xlUp).Row
    
11.         arr = .Range("i10:i" & r)
    
12.         ReDim brr(1 To UBound(arr), 1 To 7)
    
13.         For i = 1 To UBound(arr)
    
14.             xm = Split(arr(i, 1), "|")
    
15.             If UBound(xm) = 8 Then
    
16.                 For j = 1 To 5
    
17.                     brr(i, j) = xm(j)
    
18.                 Next
    
19.                 If Right(xm(6), 1) = "-" Then
    
20.                     brr(i, 6) = -Val(xm(6))
    
21.                 Else
    
22.                     brr(i, 6) = Val(xm(6))
    
23.                 End If
    
24.                 brr(i, 7) = reg.Replace(xm(7), Empty)
    
25.             End If
    
26.         Next
    
27.         .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
28.     End With
    
29. End Sub
    

复制代码

chxw68

详见附件。

sampsonpon

chxw68 发表于 2024-9-5 14:04
详见附件。

老师请帮我加一句：删除I2:I列数据。谢谢！

chxw68

修改好了。

limonet

Sub limonet()
    Dim Arr(1 To 99999, 1 To 7)  As Variant, Brr As Variant, Trr As Variant, i%, j%, S
    Brr = Range("I2").CurrentRegion
    For i = 9 To UBound(Brr)
        Trr = Split(Brr(i, 1), "|")
        For j = 1 To UBound(Trr) - 1
            If j > 5 Then
                S = Trr(j)
                Select Case j
                Case 6
                    If S Like "*-" Then S = "-" & Left(S, Len(S) - 1)
                Case 7
                    S = S * 1
                End Select
                Arr(i - 8, j) = S
            Else
                Arr(i - 8, j) = Trr(j)
            End If
        Next j
    Next i
    Range("A2").Resize(i - 9, 7) = Arr
End Sub

limonet

关键字：if+select

mjm04

用M365的话，可以使用自带的PQ来处理

PQ对这种 拆分/清理数字位数 的活 强得狠的

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr, i&, j&, r&
   
    Application.ScreenUpdating = False
   
    r = Cells(Rows.Count, "I").End(xlUp).Row
    ar = Range("I2:I" & r).Value
    ReDim br(1 To UBound(ar), 1 To 7) As String
   
    r = 0
    For i = 10 To UBound(ar) - 2
        cr = Split(ar(i, 1), "|")
        r = r + 1
        For j = 1 To UBound(br, 2)
            br(r, j) = Trim(cr(j))
        Next j
        If Right(br(r, 6), 1) = "-" Then br(r, 6) = "-" & Format(Val(br(r, 6)), "0.00")
    Next i
   
    [A1].CurrentRegion.Offset(1).Clear
    [A2].Resize(r, UBound(br, 2)) = br
    Application.ScreenUpdating = True
    Beep
End Sub