Question

我有一个excel文件我要解析D列中每个单元格的开头，并将数字复制并粘贴到单元格中（同一行，B列）如何解析数字0到9和“。”的单元格。并将该值x.x.x.x复制到B列？ D列单元格开头有多少个数字和句点的标准格式，可能是1.3.4或1.3.4。或1.3等......

value

Picture of Excel Sheet

Answer 1

编辑：现在用注释解释代码的作用

显然，您不需要现场版本中的评论。

将下面的代码粘贴到新模块中，然后将其用作WorksheetFunction （我猜测应该调用什么函数）。在任何单元格中，输入=ExtractOutline(<cell address>)，其中<cell address>是您要从中提取x.x.x的单元格。位。

Function ExtractOutline(strInput As String)

    'Function iterates through the input string until we get to a
    'character which isn't one in "0123456789." Each character which is
    'one of these is added to the output as we go along

    Dim strOut As String        'The output we're building
    Dim intPos As Integer       'The position we've reached in the input
    Dim str1Char As String      'The character found at the current position

    intPos = 1     'We'll start at the first character
    str1Char = Mid(strInput, intPos, 1)       'Extract the intPos-th character, in this case, the 1st.

    While intPos <= Len(strInput) And WorksheetFunction.Find(str1Char, "0123456789." & str1Char) < 12

    'While
    'intPos <= Len(strInput) 
    'This makes sure we haven't iterated beyond the end of the input

    'AND
    'WorksheetFunction.Find(str1Char, "0123456789." & str1Char) < 12
    'Looks for the current character in "0123456789."
    'If it wasn't found we'd get an error (as output to the function)
    'To prevent that add current character to end of "0123456789."
    'Since "Find" returns the position, within the string,
    'and "01234567890." as 11 characters, we only match the right bit if it
    'is found before the 12th character

    'Add the character to the output
    strOut = strOut & Mid(strInput, intPos, 1)

    'Increment ready for next time round the loop
    intPos = intPos + 1
    'Get the next character to be checked
    str1Char = Mid(strInput, intPos, 1) 

    Wend

    ExtractOutline = strOut

End Function

Answer 2

或者您可以将以下方法合并到您的代码中......

Sub Alex()
Dim lr As Long
Dim rng As Range, cell As Range
Dim RE As Object
Dim Match As Object

lr = Cells(Rows.Count, 4).End(xlUp).Row
Set rng = Range("D2:D" & lr)
Set RE = CreateObject("VBScript.RegExp")

RE.Pattern = "([0-9]\.){1,}"

For Each cell In rng
If RE.test(cell.Value) = True Then
   Set Match = RE.Execute(cell.Value)
   cell.Offset(0, -2).Value = Left(Match(0), Len(Match(0)) - 1)
End If
Next cell
End Sub

Answer 3

像这样的东西

您可以看到RegExp示例here

码

Sub EddieBetts()

Dim rng1 As Range
Dim lngCnt As Long
Dim objRegex As Object
Dim X

Set rng1 = Range([d2], Cells(Rows.Count, "D").End(xlUp))
X = rng1.Value2
Set objRegex = CreateObject("VBScript.RegExp")
objRegex.Pattern = "([0-9\.])+"

For lngCnt = 1 To UBound(X, 1)
    If objRegex.test(X(lngCnt, 1)) Then X(lngCnt, 1) = objRegex.Execute(X(lngCnt, 1))(0)
Next

rng1.Offset(0, -2).Value2 = X

End Sub

如何解析包含x.x.x的单元格的一部分。并将数据复制到另一个单元格？

3 个答案:

编辑：现在用注释解释代码的作用