减少字符串并保持零完整

Question

我正在处理格式为“XXXX-000-000-000”的单元格值。

• 第一个连字符之前的所有内容都需要删除，我可以这样做。
• 字符串的其余部分需要缩小为整数，并使用连字符，并删除任何额外的零。

我无法将零保留在正确的位置。

• AD12-002-020-34需要看起来像这样：2-20-34
• CA1-002-101-001需要如下所示：2-101-1
• AD12-002-020-10需要看起来像这样：2-20-10

例如：

dim ir as range

ir = "AD12-002-020-100"

ir1 = InStr(ir, "-")
ir2 = InStrRev(ir, "-")
ir.Offset(0, 1) = Mid(ir, ir1 + 1, ir2 - ir1 + 3)

这给了我：002-020-100

连连呢？提前谢谢！

Answer 1

考虑：

Sub dural()
    Dim s As String
    s = "AD12-002-020-34"
    s = Replace(s, "-0", "-")
    s = Replace(s, "-0", "-")
    ary = Split(s, "-")
    ary(0) = ""
    s = Mid(Join(ary, "-"), 2)
    MsgBox s
End Sub

Answer 2

此外，这将作为UDF（用户定义的函数）

Function STRIP(r As String)
    If InStr(1, r, "-00", vbTextCompare) Then
        r = Replace(r, "-00", "-")
    End If
    If InStr(1, r, "-0", vbTextCompare) Then
        r = Replace(r, "-0", "-")
    End If
    Dim v As Variant, s As String, i As Long
    v = Split(r, "-")
    For i = 1 To UBound(v)
        s = s & "-" & v(i)
    Next i
    STRIP = Right(s, Len(s) - 1)
End Function

您只需在=STRIP(A1)的任何单元格中调用该文件，其中A1是您要拆分的任何单元格的引用

示例：

Answer 3

UDF不是必需的（但显然是一个更好的主意！）：

=LEFT(MID(A1,FIND("-",A1)+1,LEN(A1)),FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)))-1)*1&"-"&VALUE(MID(MID(A1,FIND("-",A1)+1,LEN(A1)),FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)))+1,FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)),FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)))+1)-FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)))-1))&"-"&VALUE(MID(MID(A1,FIND("-",A1)+1,LEN(A1)),FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)),FIND("-",MID(A1,FIND("-",A1)+1,LEN(A1)))+1)+1,LEN(A1)))

Answer 4

regex方法

Sub TestCleanNames()
   Debug.Print CleanString("AD12-002-020-34")
   Debug.Print CleanString("CA1-002-101-001")
   Debug.Print CleanString("AD12-002-020-10")
End Sub

Function CleanString(strIn As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
      'remove first portion
      .Pattern = "(.+?)-"
      CleanString = .Replace(strIn, vbNullString)
      .Global = True
      'trim leasfing zeroes
      .Pattern = "(\-|^)(0)+([1-9])"
      CleanString = .Replace(CleanString, "$1$3")
    End With
End Function

Answer 5

我也可以玩吗？ ：P

A One liner

Debug.Print Mid(Replace(Replace(Replace(Mid(sString, InStr(1, sString, "-")), "-000", "-"), "-00", "-"), "-0", "-"), 2)

其中sString是有效的"XXXX-000-000-000"字符串

Answer 6

Sub x()    
    'Technically, you don't have to declare variables, but it prevents typos:
    Dim ir As String
    Dim ir1 As String
    Dim ir2 As String
    Dim ir3 As String
    ir = "AD12-002-020-100"

    'First, get rid of the first 5 characters:
    ir = Right(ir, Len(ir) - 5)

    'Isolate each section. Convert to Int to get rid of leading zeros:
    ir1 = CInt(Left(ir, 3))
    ir2 = CInt(Right(Left(ir, 7), 3))
    ir3 = CInt(Right(ir, 3))

    'Return the result:
    MsgBox ir1 & "-" & ir2 & "-" & ir3
End Sub

Answer 7

以为我会戴上这顶帽子。请注意，所有版本都假设要转换的单元格位于从单元格A1开始的A列中。

作为一个宏：

Sub tgr()

    Dim arrResults() As String
    Dim varText As Variant
    Dim varPart As Variant
    Dim ResultIndex As Long

    With Range("A1", Cells(Rows.Count, "A").End(xlUp))
        ReDim arrResults(1 To .Rows.Count, 1 To 1)
        For Each varText In .Value
            ResultIndex = ResultIndex + 1
            For Each varPart In Split(Mid(varText, InStr(varText, "-") + 1), "-")
                arrResults(ResultIndex, 1) = arrResults(ResultIndex, 1) & "-" & Val(varPart)
            Next varPart
            arrResults(ResultIndex, 1) = Mid(arrResults(ResultIndex, 1), 2)
        Next varText
        .Value = arrResults
    End With

End Sub

作为UDF：

Function tgrUDF(sText As String) As String

    Dim varPart As Variant

    For Each varPart In Split(Mid(sText, InStr(sText, "-") + 1), "-")
        tgrUDF = tgrUDF & "-" & Val(varPart)
    Next varPart

    tgrUDF = Mid(tgrUDF, 2)

End Function

作为公式：

  

= - MID（SUBSTITUTE（A1，“ - ”，REPT（“”，99）），99,99）＆amp;“ - ”＆amp; - MID（SUBSTITUTE（A1，“ - ”，REPT（ “   “，99）），99 * 2,99）＆amp;” - “＆amp; - MID（SUBSTITUTE（A1，” - “，REPT（”“，99）），99 * 3,99）