[已解决]新手求助

67469698

见附件，如何将A列做成B列的效果？

最佳答案

月排行榜 / 总排行榜

grf1973

2016-1-26 15:50

再精简一点。。。。

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         a = InStrRev(x, "-")     '反向查找“-”
   
6.         b = Val(Mid(x, a + 1))   '“-”之后是否是数值
   
7.         arr(i, 1) = IIf(b = 0, Left(x, a - 1), Left(x, a - 1) & "-" & Format(b, "00"))
   
8.     Next
   
9.     [F1].Resize(UBound(arr), UBound(arr, 2)) = arr
   
10. End Sub

复制代码

跳转到最佳答案楼层

心正意诚身修

=LEFT(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))-1)

67469698

心正意诚身修 发表于 2016-1-26 11:48
=LEFT(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))-1)

如图到这里效果就不同了

67469698

心正意诚身修 发表于 2016-1-26 11:48
=LEFT(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))-1)

其实，我是想要vba做的，因为数据量挺大的，我贴出来的只是一小部分。后期，还要用字典汇总。
有人提示可以用正则表达式做，可是我没接触过

心正意诚身修

=IF(ISERROR(--MID(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))+1,1)),LEFT(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))-1),LEFT(A2,LOOKUP(0,0*(MID(A2,ROW($A$1:$A$30),1)),ROW($A$1:$A$39))))
感觉有点复杂了。。。等等别人的答案吧。

67469698

心正意诚身修 发表于 2016-1-26 12:57
=IF(ISERROR(--MID(A2,FIND("@",SUBSTITUTE(A2,"-","@",LEN(A2)-LEN(SUBSTITUTE(A2,"-",""))))+1,1)),LEFT( ...

Sub ()

    Columns("A:A").Select
    Selection.Replace What:="BL", Replacement:="  ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
老師，我有一個思路，由於要替換的都是固定的，bk，bl，pi等
那麼我每次循環替換這些就可以？錄製了一個宏，可是不知道怎麼改代碼

！

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         a = InStrRev(x, "-")     '反向查找“-”
   
6.         k = a - 1     '截取头部
   
7.         If Val(Mid(x, a + 1)) > 0 Then          '“-”后是否是数字，如有，取头部+数字部分为最终结果，否则取头部为结果
   
8.             For j = a + 1 To Len(x)
   
9.                 If Not IsNumeric(Mid(x, j, 1)) Then Exit For
   
10.             Next
    
11.             k = j - 1
    
12.         End If
    
13.         arr(i, 1) = Left(x, k)
    
14.     Next
    
15.     [F1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
16. End Sub
    

复制代码

grf1973

代码优化一下

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         a = InStrRev(x, "-")     '反向查找“-”
   
6.         For j = a + 1 To Len(x)       '“-”向后找，非数字即跳出
   
7.             If Not IsNumeric(Mid(x, j, 1)) Then Exit For
   
8.         Next
   
9.         k = IIf(j = a + 1, a - 1, j - 1)      '有数字取到数字部分为最终结果，否则取到“-”之前为结果
   
10.         arr(i, 1) = Left(x, k)
    
11.     Next
    
12.     [F1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
13. End Sub

复制代码

grf1973

再精简一点。。。。

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 1)
   
5.         a = InStrRev(x, "-")     '反向查找“-”
   
6.         b = Val(Mid(x, a + 1))   '“-”之后是否是数值
   
7.         arr(i, 1) = IIf(b = 0, Left(x, a - 1), Left(x, a - 1) & "-" & Format(b, "00"))
   
8.     Next
   
9.     [F1].Resize(UBound(arr), UBound(arr, 2)) = arr
   
10. End Sub

复制代码