[已解决]求高手用vb帮忙拆一下

love586

求高手用vb帮忙拆一下，不要公式，谢谢

最佳答案

月排行榜 / 总排行榜

心正意诚身修

2021-11-23 00:16

love586 发表于 2021-11-22 23:51
不可以的，附件是文本格式，原件是公式得出的结果

1. Sub 拆分()
   
2. Dim ARR1, ARR2(), I As Integer, J As Integer, ARR3()
   
3. ARR1 = Split(Range("C2"), "(")
   
4. I = UBound(ARR1)
   
5. ReDim ARR2(1 To I)
   
6. For J = 1 To I
   
7. ARR2(J) = Mid(ARR1(J), 1, InStr(ARR1(J), ")") - 1)
   
8. Next
   
9. Range("d2").Resize(1, J - 1) = ARR2
   
10. ARR1 = Split(Range("b3"), "(")
    
11. I = UBound(ARR1)
    
12. ReDim ARR3(1 To I)
    
13. For J = 1 To I
    
14. ARR3(J) = Mid(ARR1(J), 1, InStr(ARR1(J), ")") - 1)
    
15. Next
    
16. Range("b4").Resize(J - 1, 1) = Application.Transpose(ARR3)
    
17. End Sub

复制代码

跳转到最佳答案楼层

心正意诚身修

其实用分列。再替换，，二十秒就可以完成了。

love586

心正意诚身修 发表于 2021-11-22 23:43
其实用分列。再替换，，二十秒就可以完成了。

不可以的，附件是文本格式，原件是公式得出的结果

心正意诚身修

love586 发表于 2021-11-22 23:51
不可以的，附件是文本格式，原件是公式得出的结果

1. Sub 拆分()
   
2. Dim ARR1, ARR2(), I As Integer, J As Integer, ARR3()
   
3. ARR1 = Split(Range("C2"), "(")
   
4. I = UBound(ARR1)
   
5. ReDim ARR2(1 To I)
   
6. For J = 1 To I
   
7. ARR2(J) = Mid(ARR1(J), 1, InStr(ARR1(J), ")") - 1)
   
8. Next
   
9. Range("d2").Resize(1, J - 1) = ARR2
   
10. ARR1 = Split(Range("b3"), "(")
    
11. I = UBound(ARR1)
    
12. ReDim ARR3(1 To I)
    
13. For J = 1 To I
    
14. ARR3(J) = Mid(ARR1(J), 1, InStr(ARR1(J), ")") - 1)
    
15. Next
    
16. Range("b4").Resize(J - 1, 1) = Application.Transpose(ARR3)
    
17. End Sub

复制代码

love586

心正意诚身修 发表于 2021-11-23 00:16

把括号去了，出现数字了，字母不见了

心正意诚身修

love586 发表于 2021-11-23 00:37
把括号去了，出现数字了，字母不见了

你要保留括号，是这样意思吗？还是说不要括号 ，，但是目前有个地方少了？

心正意诚身修

love586 发表于 2021-11-23 00:37
把括号去了，出现数字了，字母不见了

1. Sub 拆分()
   
2. Dim ARR1, ARR2(), I As Integer, J As Integer, ARR3(), ARR4
   
3. ARR1 = Split(Range("C2"), " ")
   
4. I = UBound(ARR1)
   
5. ReDim ARR2(1 To I + 1)
   
6. For J = 1 To I + 1
   
7. ARR2(J) = ARR1(J - 1)
   
8. Next
   
9. Range("d2").Resize(1, J - 1) = ARR2
   
10. ARR4 = Split(Range("b3"), " ")
    
11. I = UBound(ARR4)
    
12. ReDim ARR3(1 To I + 1)
    
13. For J = 1 To I + 1
    
14. ARR3(J) = ARR4(J - 1)
    
15. Next
    
16. Range("b4").Resize(J - 1, 1) = Application.Transpose(ARR3)
    
17. End Sub
    
18. 
    

复制代码

你换成这个试下。看看

love586

心正意诚身修 发表于 2021-11-23 09:54
你换成这个试下。看看

谢谢，完美