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

Excel Zelle auf bestimmte Anzahl von Zeichen begrenzen mit VBA

Frage Entwicklung VB for Applications

Mitglied: Anna2701

Anna2701 (Level 1) - Jetzt verbinden

19.08.2014, aktualisiert 12:16 Uhr, 2800 Aufrufe, 8 Kommentare

Hallo zusammen,

ich würde gerne eine Zelle einer Excel Tabelle auf 132 Zeichen begrenzen und der Rest der über bleibt in die Zelle darunter/neben setzen, falls dort dann auch noch mehr als 132 Zeichen sind, wieder darunter/neben. Heißt gerne als schleife, solange die Zeichenanzahl > 132 ist.
Habe schon in verschiedenen Foren geguckt, aber nirgends eine funktionstüchtige Antwort gefunden.

Danke im voraus, Anna!
Mitglied: colinardo
19.08.2014, aktualisiert um 10:17 Uhr
Hallo Anna,
hier ein Beispiel in dem die Zelle A1 im aktiven Tabellenblatt wie gewünscht auf gesplittet wird, und in die nächsten Zeilen darunter verteilt wird.
01.
Sub SplitText() 
02.
    dim rngCurrent as Range, intMaxChars as integer 
03.
    intMaxChars = 132 
04.
    Set rngCurrent = ActiveSheet.Range("A1") 
05.
    ' solange die Zelle in rngCurrent mehr als die angegebene Anzahl an Zeichen enthält ... 
06.
    While Len(rngCurrent.Value) > intMaxChars 
07.
        'setze Wert der Zelle unterhalb der aktuellen 
08.
        rngCurrent.Offset(1, 0).Value = Mid(rngCurrent.Value, intMaxChars + 1) 
09.
        ' setze Werte der aktuellen Zelle 
10.
        rngCurrent.Value = Left(rngCurrent.Value, intMaxChars) 
11.
        'aktuelle Zelle eins nach unten verschieben 
12.
        Set rngCurrent = rngCurrent.Offset(1, 0) 
13.
    Wend 
14.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: Anna2701
19.08.2014 um 10:22 Uhr
Danke Uwe, funktioniert super. Hast du vielleicht noch einen Tip, wie ich bei einer vorhandenen Tabelle die Zeile 2 nicht überschreiben lasse sondern unter die benötigten Zeilen einfüge?
Bitte warten ..
Mitglied: colinardo
19.08.2014, aktualisiert um 10:37 Uhr
Zitat von Anna2701:

Danke Uwe, funktioniert super. Hast du vielleicht noch einen Tip, wie ich bei einer vorhandenen Tabelle die Zeile 2 nicht
überschreiben lasse sondern unter die benötigten Zeilen einfüge?
no problem, Zeile 8 macht hier das gewünschte
01.
Sub SplitText() 
02.
    Dim rngCurrent As Range, intMaxChars As Integer 
03.
    intMaxChars = 132 
04.
    Set rngCurrent = ActiveSheet.Range("A1") 
05.
    ' solange die Zelle in rngCurrent mehr als die angegebene Anzahl an Zeichen enthält ... 
06.
    While Len(rngCurrent.Value) > intMaxChars 
07.
        'Neue Zeile einfügen 
08.
        rngCurrent.Offset(1, 0).EntireRow.Insert 
09.
        'setze Wert der Zelle unterhalb der aktuellen 
10.
        rngCurrent.Offset(1, 0).Value = Mid(rngCurrent.Value, intMaxChars + 1) 
11.
        ' setze Werte der aktuellen Zelle 
12.
        rngCurrent.Value = Left(rngCurrent.Value, intMaxChars) 
13.
        'aktuelle Zelle eins nach unten verschieben 
14.
        Set rngCurrent = rngCurrent.Offset(1, 0) 
15.
    Wend 
16.
End Sub
Bitte warten ..
Mitglied: Anna2701
19.08.2014 um 11:16 Uhr
Yeeeay Supi. Habe nur noch ein einziges Problem, dann ist es Perfekt :D
Im Moment gilt die Programmierung ja nur für A1 kann ich das erweitern? habe es versucht, ohne Erfolg.
Danke Uwe, du ist echt eine super Hilfe
Bitte warten ..
Mitglied: colinardo
LÖSUNG 19.08.2014, aktualisiert um 20:13 Uhr
Zitat von Anna2701:

Yeeeay Supi. Habe nur noch ein einziges Problem, dann ist es Perfekt :D
Im Moment gilt die Programmierung ja nur für A1 kann ich das erweitern? habe es versucht, ohne Erfolg.
Danke Uwe, du ist echt eine super Hilfe .
Für deinen geschilderten Fall habe ich mal angenommen das du die Zellen nebenan auch so handhaben willst, in Zeile 4 lässt sich dann der Range angeben. Hierbei wird auch das Einfügen neuer Zeilen in der Schleife beachtet (Zeile 9-11) und nur eine neue eingefügt wenn die nächste Zeile Daten enthält, da es ja sonst zu leeren Spalten kommen würde. Das solltest du für deine Zwecke anpassen können, das Prinzip ist ja damit klar.
01.
Sub SplitTextToLength() 
02.
    Dim rngCurrent As Range, intMaxChars As Integer 
03.
    intMaxChars = 132 
04.
    For Each cell In ActiveSheet.Range("A1:C1") 
05.
        Set rngCurrent = cell 
06.
        ' solange die Zelle in rngCurrent mehr als die angegebene Anzahl an Zeichen enthält ... 
07.
        While Len(rngCurrent.Value) > intMaxChars 
08.
            'Neue Zeile einfügen nur einfügen wenn die nächste Zeile nicht leer ist 
09.
            If rngCurrent.Offset(1, 0).Value <> "" Then 
10.
                rngCurrent.Offset(1, 0).EntireRow.Insert 
11.
            End If 
12.
            'setze Wert der Zelle unterhalb der aktuellen 
13.
            rngCurrent.Offset(1, 0).Value = Mid(rngCurrent.Value, intMaxChars + 1) 
14.
            ' setze Werte der aktuellen Zelle 
15.
            rngCurrent.Value = Left(rngCurrent.Value, intMaxChars) 
16.
            'aktuelle Zelle eins nach unten verschieben 
17.
            Set rngCurrent = rngCurrent.Offset(1, 0) 
18.
        Wend 
19.
    Next 
20.
End Sub
Den Beitrag dann bitte noch auf gelöst setzen. Merci.

Viel Erfolg.
Grüße Uwe
Bitte warten ..
Mitglied: sieglos
19.01.2015 um 18:09 Uhr
Hallo Uwe,

ich bin nach stundenlanger Suche und Versuchen auf diesen Beitrag gestoßen und hoffe du kannst mir nun weiterhelfen.....mein Problem wurde mit obenstehendem Code schon zu 75% gelöst.

Ich habe eine sehr große Tabelle mit teilweise bis zu 4000 Zeichen in einer Zelle, das Teilen und Zeilen einfügen funktioniert dank dir schon perfekt.

Nur wenn z.B. die Zelle G1 einen langen Text enthält der durch das Makro auf die nächsten beiden Zeilen G2 und G3 aufgeteilt wird, sollen die Zelleninhalte von den Spalten A-F und von H-BN mitkopiert werden da der Filter ansonsten nicht mehr richtig funktioniert.

Vielen Dank für deine/eure Hilfe.

Viele Grüße
Christoph
Bitte warten ..
Mitglied: colinardo
20.01.2015 um 12:26 Uhr
Hallo Christoph wenn du die letzte Variante des Makros meinst dann lässt sich das so machen:
01.
Sub SplitTextToLength() 
02.
    Dim rngCurrent As Range, intMaxChars As Integer 
03.
    intMaxChars = 50 
04.
    For Each cell In ActiveSheet.Range("G1") 
05.
        Set rngCurrent = cell 
06.
        ' solange die Zelle in rngCurrent mehr als die angegebene Anzahl an Zeichen enthält ... 
07.
        While Len(rngCurrent.Value) > intMaxChars 
08.
            'Neue Zeile einfügen nur einfügen wenn die nächste Zeile nicht leer ist 
09.
            If rngCurrent.Offset(1, 0).Value <> "" Then 
10.
                rngCurrent.Offset(1, 0).EntireRow.Insert 
11.
            End If 
12.
            'Daten aus Spalten A-F und H:BN ebenfalls nach unten kopieren 
13.
            Range("A" & rngCurrent.Row & ":BN" & rngCurrent.Row).Copy rngCurrent.Offset(1, 0).EntireRow 
14.
            'setze Wert der Zelle unterhalb der aktuellen 
15.
            rngCurrent.Offset(1, 0).Value = Mid(rngCurrent.Value, intMaxChars + 1) 
16.
            ' setze Werte der aktuellen Zelle 
17.
            rngCurrent.Value = Left(rngCurrent.Value, intMaxChars) 
18.
            'aktuelle Zelle eins nach unten verschieben 
19.
            Set rngCurrent = rngCurrent.Offset(1, 0) 
20.
        Wend 
21.
    Next 
22.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: sieglos
20.01.2015 um 18:05 Uhr
Vielen Vielen Dank !!!

Das Makro spuckt zwar einen Runtime error "13" aus, läuft aber bis Zeile ~15.000 und ich kanns dann einfach in Schritten durchlaufen lassen.

Wäre es zu viel verlangt wenn du mir noch einen Bonus mit einbaust?
Es werden jetzt immer die Wörter bei genau 1000 Zeichen abgeschnitten. Ist es möglich die Zeilen zwischen 900-1000 Zeichen zu "cutten" - immer nach dem letzten Leerzeichen oder nach einem Zeilenumbruch?

Das wär noch der Oberhammer
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Batch & Shell
gelöst Batch Variable auf 5 Zeichen begrenzen (5)

Frage von PinkFLuffyUnicorn zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...