Zahl umwandeln mit VBA

Bild

Betrifft: Zahl umwandeln mit VBA
von: alifa
Geschrieben am: 17.07.2015 09:06:08

Hallo,
ich möchte unterschiedlich lange Zahlen so umwandeln:
aus 6883 wird 162813 (1 Mal die 6; 2 Mal die 8; 1 Mal die 3)
aus 33333331 wird 7311 (7 Mal die 3; 1 Mal die 1)
aus 109 wird 111019 (1 Mal die 1; 1 Mal die 0; 1 Mal die 9)
Habe bis jetzt vergeblich versucht, im Netz etwas zu finden und selbst etwas zu basteln. Kann mir jemand dabei helfen?
VG Erhard

Bild

Betrifft: AW: Zahl umwandeln mit VBA
von: Rudi Maintaire
Geschrieben am: 17.07.2015 09:42:04
Hallo,

Function alifa(lngTmp As Long)
  Dim i As Integer, oDic As Object, o
  Dim strTmp As String
  strTmp = CStr(lngTmp)
  Set oDic = CreateObject("scripting.dictionary")
  For i = 1 To Len(strTmp)
    oDic(Mid(strTmp, i, 1)) = oDic(Mid(strTmp, i, 1)) + 1
  Next
  For Each o In oDic
    alifa = alifa & oDic(o) & o
  Next
End Function

Gruß
Rudi

Bild

Betrifft: unterschiedliche Ergebnisse, was ist richtig?
von: Tino
Geschrieben am: 17.07.2015 09:48:51
Hallo,

 ABC
1 TinoRudi
268838816281328164813
33333333173117311
4109111019111019

Formeln der Tabelle
ZelleFormel
B2=WENN(ISTZAHL(A2); Wandeln(A2); "")
C2=WENN(ISTZAHL(A2); alifa(A2); "")
B3=WENN(ISTZAHL(A3); Wandeln(A3); "")
C3=WENN(ISTZAHL(A3); alifa(A3); "")
B4=WENN(ISTZAHL(A4); Wandeln(A4); "")
C4=WENN(ISTZAHL(A4); alifa(A4); "")

Gruß Tino

Bild

Betrifft: AW: Zahl umwandeln mit VBA
von: Tino
Geschrieben am: 17.07.2015 09:44:17
Hallo,
habe es mal so versucht.

Sub Test_Zahlen()
Dim ArData, n&
'Datenquelle
ArData = Tabelle1.Range("A2:A5")
For n = LBound(ArData) To UBound(ArData)
    If IsNumeric(ArData(n, 1)) And Len(ArData(n, 1)) > 0 Then
        ArData(n, 1) = Wandeln(ArData(n, 1))
    End If
Next n
'Ausgabe
Tabelle1.Range("B2").Resize(UBound(ArData)).Value = ArData
End Sub
Function Wandeln(varValue)
Dim i%, ii%, nValue, ArValue()
ReDim Preserve ArValue(1 To Len(varValue), 1 To 2)
For i = 1 To Len(varValue)
    nValue = Mid(varValue, i, 1)
    If ii = 0 Then
        ii = ii + 1
        ArValue(ii, 1) = 1
        ArValue(ii, 2) = nValue
    Else
        If ArValue(ii, 2) = nValue Then
            ArValue(ii, 1) = ArValue(ii, 1) + 1
        Else
            ii = ii + 1
            ArValue(ii, 1) = 1
            ArValue(ii, 2) = nValue
        End If
    End If
Next i
For i = 1 To ii
    Wandeln = Wandeln & ArValue(i, 1) & ArValue(i, 2)
Next i
End Function
Du kannst auch nur die Function Wandeln verwenden und im Excel eine Formel einsetzen.
 AB
26883162813
3333333317311
4109111019

Formeln der Tabelle
ZelleFormel
B2=WENN(ISTZAHL(A2); Wandeln(A2); "")
B3=WENN(ISTZAHL(A3); Wandeln(A3); "")
B4=WENN(ISTZAHL(A4); Wandeln(A4); "")

Gruß Tino

Bild

Betrifft: AW: Zahl umwandeln mit VBA
von: ransi
Geschrieben am: 17.07.2015 11:07:41
HAllo,
Anderer Ansatz, gleiches Ergebniß...
Tabelle1

 ABC
16883162813 
2333333317311 
3109111019 
4   

Formeln der Tabelle
ZelleFormel
B1=alifa(A1)
B2=alifa(A2)
B3=alifa(A3)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Public Function alifa(zelle)
    Dim regex As Object
    Dim objMatch As Object
    Dim I As Integer
    Set regex = CreateObject("vbScript.regexp")
    With regex
        .Pattern = "(1+|2+|3+|4+|5+|6+|7+|8+|9+|0+)"
        .Global = True
        Set objMatch = .Execute(zelle)
        For I = 1 To objMatch.Count
            alifa = alifa & objMatch(I - 1).Length & Left(objMatch(I - 1).Value, 1)
        Next
    End With
End Function


ransi

Bild

Betrifft: guter Ansatz! oT.
von: Tino
Geschrieben am: 17.07.2015 11:30:13


Bild

Betrifft: AW: Zahl umwandeln mit VBA
von: alifa
Geschrieben am: 17.07.2015 13:32:32
Hallo,
vielen Dank an alle Beteiligten! Habe die kürzeste für mein Makro gewählt(Ransi). Die klappt vorzüglich.
Erhard

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zahl umwandeln mit VBA"