Snasui Excel Forum

Code: Select all

Private Sub CommandButton1_Click()Dim regEx, myMatch, myMatches, arg
Dim i As String
Dim j As Integer
Set regEx = CreateObject("vbscript.regexp")
For j = 1 To 4
arg = Range("A" & j).Value
With regEx
.Pattern = "\d{1}"
.Global = True
If .Test(arg) Then
Set myMatches = .Execute(arg)
i = ""
For Each myMatch In myMatches
i = i & "." & myMatch.Value
Next myMatch
MsgBox ("E" & i)
End If
End With
Next j
End Sub

Code: Select all

Sub Test0()
    Dim rAll As Range, r As Range
    Dim t As String, i As Integer
    Set rAll = Sheets("Sheet1").Range("A1:A4")
    For Each r In rAll
        With Application.WorksheetFunction
            t = .Substitute(r, " Network Settings", "")
            i = .Search(" ", t) - 1
            r.Offset(0, 1) = Left(t, i)
        End With
    Next r
End Sub

Code: Select all

Sub SplitThenJoin()
    Dim s As String, a() As String
    Dim r As Range, rAll As Range
    Dim i As Integer, j As Integer, k As Integer
    Call RemoveUnused
    With Worksheets("Sheet1")
        Set rAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        s = ""
        a = Split(Right(r, Len(r) - 6), ",")
        For i = 0 To UBound(a)
            j = InStr(1, a(i), "-")
            If IsNumeric(Left(a(i), 1)) And j > 0 Then
                For k = Left(a(i), j - 1) * 100 To Mid(a(i), j + 1, 255) * 100
                    s = s & Left(r, 5) & "." & Format(k / 100, "0.00") & ","
                Next k
            End If
            If Len(s) > 1 Then
                a(i) = Left(s, Len(s) - 1)
            Else
                a(i) = Left(r, 5) & a(i) / 10
            End If
        Next i
        s = Join(a, ",")
        a = Split(s, ",")
        For i = 0 To UBound(a)
            a(i) = Replace(a(i), ".0", ".")
        Next i
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(a) + 1) _
            = Application.Transpose(a)
    Next r
End Sub

Code: Select all

Sub RemoveUnused()
    Dim rAll As Range, r As Range
    Dim t As String, v As String, u As String
    Dim i As Integer, s As String
    Set rAll = Sheets("Sheet1").Range("A1:A4")
    For Each r In rAll
        v = Left(r, 5)
        u = Replace(r, v, "")
        t = "0123456789,.-/"
        s = ""
        i = 1
        Do While i <= Len(u)
            If InStr(t, Mid(u, i, 1)) > 0 Then
                s = s & Mid(u, i, 1)
            End If
            i = i + 1
        Loop
        r.Offset(0, 1) = v & s
    Next r
End Sub

Sub SplitThenJoin()
    Dim s As String, a() As String
    Dim r As Range, rAll As Range
    Dim i As Integer, j As Integer, k As Integer
    Call RemoveUnused
    With Worksheets("Sheet1")
        Set rAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
    End With
    For Each r In rAll
        s = ""
        a = Split(Right(r, Len(r) - 6), ",")
        For i = 0 To UBound(a)
            j = InStr(1, a(i), "-")
            If IsNumeric(Left(a(i), 1)) And j > 0 Then
                For k = Left(a(i), j - 1) * 100 To Mid(a(i), j + 1, 255) * 100
                    s = s & Left(r, 5) & "." & Format(k / 100, "0.00") & ","
                Next k
            End If
            If Len(s) > 1 Then
                a(i) = Left(s, Len(s) - 1)
            ElseIf Mid(a(i), 3, 1) = "." Then
                a(i) = Left(r, 5) & "." & a(i)
            Else
                a(i) = Left(r, 5) & a(i) / 10
            End If
        Next i
        s = Join(a, ",")
        a = Split(s, ",")
        For i = 0 To UBound(a)
            a(i) = Replace(a(i), ".0", ".")
        Next i
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(a) + 1) _
            = Application.Transpose(a)
    Next r
End Sub