Wie man Text & Nummer in umge durch VBA in Microsoft Excel erhalten

Function CompleteReverse(rCell As Range, Optional IsText As Boolean)

Dim i As Integer

Dim StrNewTxt As String

Dim strOld As String

strOld = Trim(rCell)

For i = 1 To Len(strOld)

StrNewTxt = Mid(strOld, i, 1) & StrNewTxt

Next i

If IsText = False Then

CompleteReverse = CLng(StrNewTxt)

Else

CompleteReverse = StrNewTxt

End If

End Function

Function ReverseOrder1(Rng As Range)

Dim Val As Variant, Counter As Integer, R() As Variant

Val = Split(Application.WorksheetFunction.Substitute(Rng.Value, " ", ""), ",")

ReDim R(LBound(Val) To UBound(Val))

For Counter = LBound(Val) To UBound(Val)

R(UBound(Val) - Counter) = Val(Counter)

Next Counter

ReverseOrder1 = Join(R, ", ")

End Function

Function ReverseOrder2(Rng As Range) As String

Dim Counter As Long, R() As String, temp As String

R = Split(Replace(Rng.Value2, " ", ""), ",")

For Counter = LBound(R) To (UBound(R) - 1) \ 2

temp = R(UBound(R) - Counter)

R(UBound(R) - Counter) = R(Counter)

R(Counter) = temp

Next Counter

ReverseOrder2 = Join(R, ", ")

End Function

Sub ReverseColumnOrder()

Dim wBase As Worksheet, wResult As Worksheet, i As Long, x As Long

Set wBase = Sheets("Sheet1")

Set wResult = Sheets("Sheet2")

Application.ScreenUpdating = False

With wBase

For i = .Range("A1").CurrentRegion.Rows.Count To 1 Step -1

x = x + 1

.Range("A1").CurrentRegion.Rows(i).Copy wResult.Range("A" & x)

Next i

End With

Application.ScreenUpdating = True

End Sub

Function ReverseNumber1(v As Variant) As String

Dim iSt As Integer, iEnd As Integer, sNum As String, sTemp As String

iSt = InStr(v, "(")

iEnd = InStr(v, ")")

If iSt = 0 Or iEnd = 0 Then ReverseNumber1 = v: Exit Function

sNum = Mid(v, iSt + 1, iEnd - iSt - 1)



For i = Len(sNum) To 1 Step -1

sTemp = sTemp & Mid(sNum, i, 1)

Next i

ReverseNumber1 = Left(v, iSt) & sTemp & Mid(v, iEnd, 5 ^ 5)

End Function

Function ReverseNumber2(s As String) As String

Dim i&, t$, ln&

t = s: ln = InStr(s, ")") - 1

For i = InStr(s, "(") + 1 To InStr(s, ")") - 1

Mid(t, i, 1) = Mid(s, ln, 1)

ln = ln - 1

Next

ReverseNumber2 = t

End Function

Function ReverseNumber3(c00)

c01 = Split(Split(c00, ")")(0), "(")(1)

ReverseNumber3 = Replace(c00, "(" & c01 & ")", "(" & StrReverse(c01) & ")")

End Function

Function ReverseNumber4(c00)

ReverseNumber4 = Left(c00, InStr(c00, "(")) & StrReverse(Mid(Left(c00, _

InStr(c00, ")") - 1), InStr(c00, "(") + 1)) & Mid(c00, InStr(c00, ")"))

End Function

Function ReverseNumber5(s As String)

Dim m As Object

With CreateObject("VBScript.Regexp")

.Global = True

.Pattern = "(\D)(\d)"

For Each m In .Execute(s)

ReverseNumber5 = ReverseNumber5 & m.submatches(0) & StrReverse(m.submatches(1))

Next

End With

Set m = Nothing

End Function

Sub Reverse_Cell_Contents()

'this macro will run only on activecell' --- Comment

If Not ActiveCell.HasFormula Then

sRaw = ActiveCell.Text

sNew = ""

For j = 1 To Len(sRaw)

sNew = Mid(sRaw, j, 1) + sNew

Next j

ActiveCell.Value = sNew

End If

End Sub