想提高工作效率，有大神能在现有的VBA宏 基础上帮我在更新下吗？

jiaxinl

llh521 发表于 2018-6-20 09:54
可以了 可以了 大神非常感谢  想问下       rg.Pattern = " *[一-隝]+ *"   这个是  我想改成任意的韩文  ...

1. Sub ok()
   
2.    Dim arr, brr, crr, drr, err, frr(), m, k, s
   
3.    Application.ScreenUpdating = False
   
4.    Columns("A:C").EntireColumn.AutoFit
   
5.    arr = Range([A1], Range("C" & Range("C1048576").End(xlUp).Row))
   
6.    For m = 1 To UBound(arr, 1)
   
7.     If InStr(Left(arr(m, 3), InStr(3, arr(m, 3), " ")), "-") = 0 Then
   
8.         brr = Replace(arr(m, 3), Left(arr(m, 3), InStr(3, arr(m, 3), " ")), "")
   
9.     Else
   
10.         brr = Trim(arr(m, 3))
    
11.     End If
    
12.        crr = Split(brr, "/")
    
13.        For j = 0 To UBound(crr)
    
14.             drr = Split(Trim(crr(j)), "+")
    
15.             For k = 0 To UBound(drr)
    
16.                    i = i + 1
    
17.                    ReDim Preserve frr(1 To 3, 1 To i)
    
18.                     If InStr(drr(k), ")") <> 0 Then
    
19.                        err = Right(Replace(drr(k), ")", ""), Len(Replace(drr(k), ")", "")) - InStr(Replace(drr(k), ")", ""), "("))
    
20.                        s = Replace(drr(k), Mid(drr(k), InStr(drr(k), "("), Len(drr(k))), "")
    
21.                        If i = 1 Then frr(1, i) = arr(m, 1) Else frr(1, i) = arr(m, 1) & " X " & err
    
22.                        If i = 1 Then frr(2, i) = arr(m, 2) Else frr(2, i) = err
    
23.                        If k = 0 Then frr(3, i) = s Else frr(3, i) = Left(Trim(crr(j)), InStr(Trim(crr(j)), " ")) & s
    
24.                     Else
    
25.                        frr(1, i) = arr(m, 1)
    
26.                        If i = 1 Then frr(2, i) = arr(m, 2) Else frr(2, i) = 1
    
27.                        If k = 0 Then frr(3, i) = drr(k) Else frr(3, i) = Left(Trim(crr(j)), InStr(Trim(crr(j)), " ")) & drr(k)
    
28.                     End If
    
29.             Next k
    
30.        Next j
    
31.    Next m
    
32.    [E:G].Clear
    
33.    [E1].Resize(i, 3) = Application.Transpose(frr)
    
34.    Range("E1:G1").Interior.Color = 255
    
35.    Columns("E:G").EntireColumn.AutoFit
    
36.    With Range("E2:G" & i)
    
37.         .Borders(xlEdgeLeft).Color = -16776961
    
38.         .Borders(xlEdgeTop).Color = -16776961
    
39.         .Borders(xlEdgeBottom).Color = -16776961
    
40.         .Borders(xlEdgeRight).Color = -16776961
    
41.         .Borders(xlInsideVertical).Color = -16776961
    
42.         .Borders(xlInsideHorizontal).Color = -16776961
    
43.     End With
    
44. End Sub
    

复制代码

llh521

jiaxinl 发表于 2018-6-20 17:29

非常非常感谢 大神帮助  谢谢