Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Zahlen in Buchstaben automatisch umwandeln!

Frage Microsoft Microsoft Office

Mitglied: winget

winget (Level 1) - Jetzt verbinden

18.02.2014, aktualisiert 15:50 Uhr, 2114 Aufrufe, 8 Kommentare, 3 Danke

Hallo zusammen,
ich brauche für eine Datei (Zahlungsformular in Excel) in einer Zeile z.B. A1 die Zahlen und in z.B. B1 die Zahlen als Wörter / Buchstaben.

z.B.

A1 = 12345
in B1 soll dann folgendes erscheinen: EINS--ZWEI--DREI--VIER--FÜNF

In der Zeile A1 werden sowieso die Zahlen abgetippt! Damit sollen automatisch in Zeile B1 automatisch die Zahlenwörter automatisch erscheinen.

Ich habe bereits ein Makro, aber die Bedienung ist, dass die Zahl/Zahlen noch mal in der Zelle B1 abgetippt werden und dann das Macro starten und die Zeile (Ziel) im InputBox eingeben.

Anbei der Macro-Code:

01.
Sub umwandeln_Zahlen_in_Wörter() 
02.
Dim sZiel As String 
03.
 sZiel = InputBox("Geben Sie die Adresse der " & vbCr & _ 
04.
         "Zelle mit dem umzuwandelnden " & vbCr & _ 
05.
         "Text ein:", "Bitte Zelladresse angeben!") 
06.
 
07.
For Each zelle In ThisWorkbook.ActiveSheet.Range(sZiel) 
08.
   On Error Resume Next 
09.
  With zelle 
10.
      .Replace What:="1", Replacement:="EINS--" 
11.
      .Replace What:="2", Replacement:="ZWEI--" 
12.
      .Replace What:="3", Replacement:="DREI--" 
13.
      .Replace What:="4", Replacement:="VIER--" 
14.
      .Replace What:="5", Replacement:="FÜNF--" 
15.
      .Replace What:="6", Replacement:="SECHS--" 
16.
      .Replace What:="7", Replacement:="SIEBEN--" 
17.
      .Replace What:="8", Replacement:="ACHT--" 
18.
      .Replace What:="9", Replacement:="NEUN--" 
19.
      .Replace What:="0", Replacement:="NULL--" 
20.
      .Replace What:=".", Replacement:=", " 
21.
  End With 
22.
  If Right(zelle, 2) = "--" Then 
23.
    zelle.Value = Application.WorksheetFunction.Replace(zelle, Len(zelle), 1, "") 
24.
    zelle.Value = Application.WorksheetFunction.Replace(zelle, Len(zelle), 1, "") 
25.
  End If 
26.
    zelle.Value = Application.WorksheetFunction.Replace(zelle, InStr(2, zelle, ", ") - 2, 2, "") 
27.
 Next zelle 
28.
 sZiel = "" 
29.
End Sub
Kann mir jemand helfen, diese Eingabe zu automatisieren?

Vielen Dank im Voraus
Mitglied: colinardo
LÖSUNG 18.02.2014, aktualisiert um 15:50 Uhr
Hallo winget,
füge das mal in den Code des entsprechenden Sheets ein:
Im Beispiel wird bei jeder Änderung der Zellen "A1:A10" der entsprechende Wert automatisch in die Zelle daneben geschrieben, sobald man die Bearbeitung der Zelle abschließt.
01.
Private Sub Worksheet_Change(ByVal Target As Range) 
02.
     On Error Resume Next 
03.
    'Range bei dem eine Änderung etwas bewirken soll 
04.
    Set changeRange = Range("A1:A10") 
05.
    If Not Application.Intersect(changeRange, Target) Is Nothing Then 
06.
        If Target.Value <> "" Then 
07.
            Set rngTarget = Target.Offset(0, 1) 
08.
            strText = Replace(Target.Value, "1", "EINS--", 1, -1, vbTextCompare) 
09.
            strText = Replace(strText, "2", "ZWEI--", 1, -1, vbTextCompare) 
10.
            strText = Replace(strText, "3", "DREI--", 1, -1, vbTextCompare) 
11.
            strText = Replace(strText, "4", "VIER--", 1, -1, vbTextCompare) 
12.
            strText = Replace(strText, "5", "FÜNF--", 1, -1, vbTextCompare) 
13.
            strText = Replace(strText, "6", "SECHS--", 1, -1, vbTextCompare) 
14.
            strText = Replace(strText, "7", "SIEBEN--", 1, -1, vbTextCompare) 
15.
            strText = Replace(strText, "8", "ACHT--", 1, -1, vbTextCompare) 
16.
            strText = Replace(strText, "9", "NEUN--", 1, -1, vbTextCompare) 
17.
            strText = Replace(strText, "0", "NULL--", 1, -1, vbTextCompare) 
18.
            strText = Replace(strText, ".", ", ", 1, -1, vbTextCompare) 
19.
            If Right(strText, 2) = "--" Then 
20.
                strText = Left(strText, Len(strText) - 2) 
21.
            End If 
22.
            strText = Replace(strText, "--,", ",", 1, -1, vbTextCompare) 
23.
            rngTarget.Value = strText 
24.
        End If 
25.
    End If 
26.
End Sub
Siehe auch das Demo-Sheet

Grüße Uwe
Bitte warten ..
Mitglied: winget
18.02.2014, aktualisiert um 14:13 Uhr
Hi colinardo,
das funktioniert schon mal super, auch mit meinem Sheet (ich habe für mich entsprechend angepasst).

Ich habe leider von Anfang an nicht gesagt, dass ich noch ein Blatt habe, wo die Einzelbeträge eintrage.

z.B.

Sheet1 > A1:A10 werden z.B. Beträge abgetippt. In A11 wird die Summe erzeugt
Sheet2 > wie gehabt. In A1 wird der Betrag aus Sheet1_A11 übertragen. In B1 soll wie oben entsprechend funktionieren. Es funktioniert nur, wenn ich noch mal in die Zelle Sheet2_A1 rein gehe und Enter drucke.

Danke schon mal für die erste Lösung!

Gruß
Paul
Bitte warten ..
Mitglied: colinardo
18.02.2014, aktualisiert um 15:17 Uhr
Das ist auch kein Problem,
dazu machst du aus der Prozedur eine Public Function und fügst sie in ein Modul ein:
01.
Public Function zahlToText(zahl) 
02.
    strText = Replace(zahl, "1", "EINS--", 1, -1, vbTextCompare) 
03.
    strText = Replace(strText, "2", "ZWEI--", 1, -1, vbTextCompare) 
04.
    strText = Replace(strText, "3", "DREI--", 1, -1, vbTextCompare) 
05.
    strText = Replace(strText, "4", "VIER--", 1, -1, vbTextCompare) 
06.
    strText = Replace(strText, "5", "FÜNF--", 1, -1, vbTextCompare) 
07.
    strText = Replace(strText, "6", "SECHS--", 1, -1, vbTextCompare) 
08.
    strText = Replace(strText, "7", "SIEBEN--", 1, -1, vbTextCompare) 
09.
    strText = Replace(strText, "8", "ACHT--", 1, -1, vbTextCompare) 
10.
    strText = Replace(strText, "9", "NEUN--", 1, -1, vbTextCompare) 
11.
    strText = Replace(strText, "0", "NULL--", 1, -1, vbTextCompare) 
12.
    strText = Replace(strText, ".", ", ", 1, -1, vbTextCompare) 
13.
    If Right(strText, 2) = "--" Then 
14.
        strText = Left(strText, Len(strText) - 2) 
15.
    End If 
16.
    strText = Replace(strText, "--,", ",", 1, -1, vbTextCompare) 
17.
    zahlToText = strText 
18.
End Function
dann fügst du folgenden Code in jedes Sheet ein welches diese Funktion haben soll:
01.
Private Sub Worksheet_Change(ByVal Target As Range) 
02.
    On Error Resume Next 
03.
    Set changeRange = Range("A1:A10") 
04.
    If Not Application.Intersect(changeRange, Target) Is Nothing Then 
05.
            If Target.Value <> "" Then 
06.
                Target.Offset(0, 1).Value = zahlToText(Target.Value) 
07.
            Else 
08.
                Target.Offset(0, 1).Value = "" 
09.
            End If 
10.
    End If 
11.
End Sub
Demo Sheet von oben ist darauf hin aktualisiert, falls das nicht klar war.

Grüße Uwe
Bitte warten ..
Mitglied: winget
18.02.2014 um 14:49 Uhr
Ich verstehe, was du meinst, aber das ist nicht das Problem.
Ich wollte dir meine Beispiel Datei hier hoch laden, aber ich habe leider nicht gefunden, wie es geht!

Ich versuche noch mal zu Erklären.

Tabelle1 und Tabelle2 (keine weiter Tabellen)

In Tabelle1 (A1:A10) sind die Zahlen, die abgetippt werden! In A11 ist die Summe
In Tabelle2 A1 ist die Summe aus Tablle1_A11 und die B1 die Buchstabenumwandlung die Umwandlung von Zahlen in Wörter.

Ändert sich eine Zahl in Tabelle1 in Zellen A1:A10, ändert sich natürlich auch die Summe in A11 (Tabelle1) aber auch der Betrag in Tabelle2_A1. Aber die Umwandlung in B1 funktioniert nicht automatisch > nur wenn man z.B. in die Zelle Tabelle2_A1 rein geht und Enter druckt.

Ich hoffe, dass das jetzt einigermaßen verständlich ist.
Bitte warten ..
Mitglied: colinardo
LÖSUNG 18.02.2014, aktualisiert um 15:50 Uhr
Ach so, auch kein Thema, schau einfach ins obige Demo-Sheet, hab's da angepasst ...
Bitte warten ..
Mitglied: winget
18.02.2014, aktualisiert um 15:49 Uhr
Super geholfen!
Ich habe der Code ein bisschen angepasst. In der Tabelle1 sollen keine Umwandlung stattfinden.
Siehe unten die Endlösung, was ich eigentlich suchte. Auch für andere Forumsuser, die sowas brauchen.
Vielen vielen Dank

Publich function wie gehabt (z.B. Modul1)

01.
Public Function zahlToText(zahl) 
02.
    strText = Replace(zahl, "1", "EINS--", 1, -1, vbTextCompare) 
03.
    strText = Replace(strText, "2", "ZWEI--", 1, -1, vbTextCompare) 
04.
    strText = Replace(strText, "3", "DREI--", 1, -1, vbTextCompare) 
05.
    strText = Replace(strText, "4", "VIER--", 1, -1, vbTextCompare) 
06.
    strText = Replace(strText, "5", "FÜNF--", 1, -1, vbTextCompare) 
07.
    strText = Replace(strText, "6", "SECHS--", 1, -1, vbTextCompare) 
08.
    strText = Replace(strText, "7", "SIEBEN--", 1, -1, vbTextCompare) 
09.
    strText = Replace(strText, "8", "ACHT--", 1, -1, vbTextCompare) 
10.
    strText = Replace(strText, "9", "NEUN--", 1, -1, vbTextCompare) 
11.
    strText = Replace(strText, "0", "NULL--", 1, -1, vbTextCompare) 
12.
    strText = Replace(strText, ".", ", ", 1, -1, vbTextCompare) 
13.
    If Right(strText, 2) = "--" Then 
14.
        strText = Left(strText, Len(strText) - 2) 
15.
    End If 
16.
    strText = Replace(strText, "--,", ",", 1, -1, vbTextCompare) 
17.
    zahlToText = strText 
18.
End Function
und Sheet (Blatt) Code:

01.
Private Sub Worksheet_Change(ByVal Target As Range) 
02.
    On Error Resume Next 
03.
    Set changeRange = Range("A1:A10") 
04.
    If Not Application.Intersect(changeRange, Target) Is Nothing Then 
05.
        Worksheets(2).Range("B1").Value = zahlToText(Worksheets(2).Range("A1").Value) 
06.
    End If 
07.
End Sub
Bitte warten ..
Mitglied: colinardo
LÖSUNG 18.02.2014, aktualisiert um 15:51 Uhr
alles klar,
Zeile 3 in der Function ist noch doppelt, die kannst du noch löschen.

Wenns das dann war, den Beitrag bitte noch auf gelöst setzen, und die Lösungskommentare markieren. Merci.

Grüße Uwe
Bitte warten ..
Mitglied: winget
18.02.2014 um 15:51 Uhr
Das stimmt...ich hab's noch geändert..Danke
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
C und C++
gelöst Anzahl der Buchstaben in einem String Element Array C++ (3)

Frage von Protected zum Thema C und C ...

Microsoft Office
Registerkarte in Excel automatisch färben (10)

Frage von ralfkausk zum Thema Microsoft Office ...

Windows Server
Jnlp Endungen mit Java automatisch verknüpfen über GPO (10)

Frage von staybb zum Thema Windows Server ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...