TEXT TO COLUMN

hetrick

各位師兄，我有一個Excel file的資料是由另外的system得出來，沒有分column, 本來可用text to column，但是每次費時，因有些數字前面多了"0", 有些後面有"+"，不是所有資料都有用，有用是我已用紅包, 如用VBA可否做到？D:\TEXT TO COLUMN

limonet

函数，VBA思路可参考
=TEXTSPLIT(REGEXREPLACE(DATA!A1,"(FU12) +([A-Z]{3}).*?(153).*?(10).*?(15660015)\+.*?(ABCUS40600).*?(RTYU4 INDEX).*","$1￥$2￥$3￥$4￥$5￥$6￥$7"),"￥")

ynzsvt

颜色是已知条件还是位置是已知条件，一切都是由你自己说了算。

hetrick

顏色是固定位置，每行可能不同資料
          A
1       FU12      USDUSDUSD                0013248000      
2       FU22      EUREUREUR                 0024000000
3       FU12      USDUSDUSD                 0008500000

RESULT
             A          B                      C
1       FU12      USD                132480      
2       FU22      EUR                 240000
3       FU12      USD                 85000

3

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr, crr()
   
4.     Dim reg As New RegExp
   
5.     With reg
   
6.         .Global = True
   
7.         .Pattern = "\s+"
   
8.     End With
   
9.     With Worksheets("data")
   
10.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.         arr = .Range("a1:a" & r)
    
12.         ReDim crr(1 To UBound(arr), 1 To 7)
    
13.         For i = 1 To UBound(arr)
    
14.             ss = reg.Replace(arr(i, 1), " ")
    
15.             brr = Split(ss, " ")
    
16.             crr(i, 1) = brr(0)
    
17.             crr(i, 2) = Left(brr(1), 3)
    
18.             crr(i, 3) = Mid(brr(3), 8, 3)
    
19.             crr(i, 4) = Mid(brr(4), 7, 2)
    
20.             crr(i, 5) = Mid(brr(5), 5, 8)
    
21.             crr(i, 6) = brr(7)
    
22.             crr(i, 7) = brr(8) & " " & brr(9)
    
23.         Next
    
24.     End With
    
25.     With Worksheets("target")
    
26.         .Cells.Clear
    
27.         .Range("a1").Resize(UBound(crr), UBound(crr, 2)) = crr
    
28.     End With
    
29. End Sub
    

复制代码

chxw68

参与一下。

hetrick

師兄，可否寫VBA碼給我，我每次開FILE，宅都顯示不能執行巨集，謝謝

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr, i&, j&, n&
   
    Application.ScreenUpdating = False
   
    ar = Worksheets(1).[A1].CurrentRegion.Value
    ReDim br(1 To UBound(ar), 1 To 10 ^ 3) As String
   
    With Worksheets(2)
        For i = 1 To UBound(ar)
            cr = Split(ar(i, 1))
            n = 0
            For j = 0 To UBound(cr)
                If Len(cr(j)) Then n = n + 1: br(i, n) = cr(j)
            Next j
            br(i, 2) = Mid(br(i, 2), 3, 3)
            br(i, 3) = Mid(br(i, 4), 8, 3)
            br(i, 4) = Mid(br(i, 5), 6, 2)
            br(i, 5) = Mid(br(i, 6), 5, 8)
            br(i, 6) = br(i, 8)
            br(i, 7) = br(i, 9) & " " & br(i, 10)
        Next i
        .Cells.Clear
        .[A1].Resize(UBound(br), 7) = br
        .Activate
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

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

hetrick

師兄，我用的是繁體中文OFFICE 2016, 每次開FILE都會鬧我 "已移除的部分: /xl/vbaProject.bin 部分。  (Visual Basic for Applications (VBA))", 可否顯示你的VBA 碼給我。