VBA in Excel zum Umbenennen von Strings
Hallo liebes Forum,
ich bitte Euch vorab um Eure Nachsicht bei meiner Anfängerfrage:
Ich möchte folgende Änderungen in Abhängigkeit vom Stringinhalt in einem String vornehmen:
aus z.B.
EP000000900709B1 soll ein EP_0900709_B1,
DE000010119042A1 soll ein DE_10119042_A1,
JP002006021737AA soll ein JP_20060021737_AA,
US020060108766A1 soll ein US_20060108766_A1, und
WO002006046790A1 soll ein WO_20060046790_A1 werden.
D.h.
1) nach den ersten zwei Buchstaben soll ein "_" eingefügt werden,
2) in Abhängigkeit von den ersten Buchstaben sollen bei z.B.
EP: die ersten 5 "0" abgeschnitten,
DE: die ersten 4 "0" abgeschnitten,
JP: die ersten 2 "0" abgeschnitten,
US: die erste "0" abgeschnitten und
WO: die ersten 2 "0" abgeschnitten werden.
3) nach der letzten Ziffer (von links nach rechts durch den String gehend) soll ein "_" eingefügt werden.
b) Wie kann ich aus etwas Derartigem ein Symbol in der Symbolleiste erstellen?
Vielen Dank für Eure Hilfe im Voraus!
Grüße
Fusselfrei
ich bitte Euch vorab um Eure Nachsicht bei meiner Anfängerfrage:
Ich möchte folgende Änderungen in Abhängigkeit vom Stringinhalt in einem String vornehmen:
aus z.B.
EP000000900709B1 soll ein EP_0900709_B1,
DE000010119042A1 soll ein DE_10119042_A1,
JP002006021737AA soll ein JP_20060021737_AA,
US020060108766A1 soll ein US_20060108766_A1, und
WO002006046790A1 soll ein WO_20060046790_A1 werden.
D.h.
1) nach den ersten zwei Buchstaben soll ein "_" eingefügt werden,
2) in Abhängigkeit von den ersten Buchstaben sollen bei z.B.
EP: die ersten 5 "0" abgeschnitten,
DE: die ersten 4 "0" abgeschnitten,
JP: die ersten 2 "0" abgeschnitten,
US: die erste "0" abgeschnitten und
WO: die ersten 2 "0" abgeschnitten werden.
3) nach der letzten Ziffer (von links nach rechts durch den String gehend) soll ein "_" eingefügt werden.
b) Wie kann ich aus etwas Derartigem ein Symbol in der Symbolleiste erstellen?
Vielen Dank für Eure Hilfe im Voraus!
Grüße
Fusselfrei
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 125480
Url: https://administrator.de/contentid/125480
Ausgedruckt am: 26.11.2024 um 15:11 Uhr
20 Kommentare
Neuester Kommentar
Das sieht mir verdächtig nach Schulaufgabe auf... Naja egal, also ich habe gerade mal 15 - 20 Minuten nachgeschaut...
Als erstes benötigst Du eine Funktion (toChange), die überprüft ob der String geändert werden muss.
Als zweites fügst du zwei Unterstrich ein (addUnderscore)
Danach löschst du die Nullen (deleteZeros) und fügst alles in die Zeile ein.
Du brauchst jetzt nur noch eine "Main"funktion, die mit zwei Forschleifen über einen bestimmten bereich deiner Arbeitsmappe iteriert und die "toChange" funktion aufruft.
Ich habe folgende Funktionen
Sub changeTableFormat() 'meine Main-Funktion
Function changeFormat(strToChange As String) As String 'die Funktion die gegebenenfalls ändert
Function toChange(str As String) As Boolean 'die funktion prüft lediglich, ob geändert werden muss
Function addUnderscore(oldString As String, underscorePosition As Integer) As String 'wie gesagt fügt diese Funktion zwei unterstriche ein
Function deleteZeros(oldString As String) As String 'hier werden überflüssige nullen gelöscht
die erste Sub ruft die erste function auf, die wiederum die zweite function die dann die dritte und die vierte function
Ich hoffe ich konnte dir einen lösungsansatz bieten
Als erstes benötigst Du eine Funktion (toChange), die überprüft ob der String geändert werden muss.
Als zweites fügst du zwei Unterstrich ein (addUnderscore)
Danach löschst du die Nullen (deleteZeros) und fügst alles in die Zeile ein.
Du brauchst jetzt nur noch eine "Main"funktion, die mit zwei Forschleifen über einen bestimmten bereich deiner Arbeitsmappe iteriert und die "toChange" funktion aufruft.
Ich habe folgende Funktionen
Sub changeTableFormat() 'meine Main-Funktion
Function changeFormat(strToChange As String) As String 'die Funktion die gegebenenfalls ändert
Function toChange(str As String) As Boolean 'die funktion prüft lediglich, ob geändert werden muss
Function addUnderscore(oldString As String, underscorePosition As Integer) As String 'wie gesagt fügt diese Funktion zwei unterstriche ein
Function deleteZeros(oldString As String) As String 'hier werden überflüssige nullen gelöscht
die erste Sub ruft die erste function auf, die wiederum die zweite function die dann die dritte und die vierte function
Ich hoffe ich konnte dir einen lösungsansatz bieten
Hallo Fusselfrei!
Wie soll das mit den unterschiedlichen Nullen funktionieren, wenn noch andere Kürzel vorkommen und sind am Ende immer 2 Zeichen (_XY)?
Gruß Dieter
Wie soll das mit den unterschiedlichen Nullen funktionieren, wenn noch andere Kürzel vorkommen und sind am Ende immer 2 Zeichen (_XY)?
Gruß Dieter
Hallo Fusselfrei!
Wieviel verschiedene Kombinationen soll's am Anfang geben z.B. >10, >20...?
Gruß Dieter
Wieviel verschiedene Kombinationen soll's am Anfang geben z.B. >10, >20...?
Gruß Dieter
Ich würde es so machen:
Function KillZero(ByVal Str As String) As Integer
Select Case Str
Case "EP"
KillZero = 5
Case "DE"
KillZero = 4
'Case "Bl" ....
End Select
End Function
Sub Main()
Dim Str As String
Str = InputBox("Stringeingabe")
FirstTwo = Left(Str, 2)
LastTwo = Right(Str, 2)
cutnull = KillZero(FirstTwo)
LenMid = Len(Str) - 4 - cutnull
Middle = Mid(Str, 3 + cutnull, LenMid)
Res = FirstTwo & "_" & Middle & "_" & LastTwo
MsgBox Res
End Sub
Hallo Fusselfrei!
Heute ist zwar kein Montag, aber irgendwie steh ich auf'm Schlauch
Wie ist das jetzt zu verstehen?
Macht eventuell Sinn, ein Tabellenblatt anzulegen, das ausgeblendet werden kann und z.B. in Spalte A die zwei Buchstaben und B die Anzahl der Nullen stehen?
Oder umgekehrt nur die Buchstaben-Codes verwenden, bei denen Nullen stehen bleiben?
Gruß Dieter
Heute ist zwar kein Montag, aber irgendwie steh ich auf'm Schlauch
Wie ist das jetzt zu verstehen?
Macht eventuell Sinn, ein Tabellenblatt anzulegen, das ausgeblendet werden kann und z.B. in Spalte A die zwei Buchstaben und B die Anzahl der Nullen stehen?
Oder umgekehrt nur die Buchstaben-Codes verwenden, bei denen Nullen stehen bleiben?
Gruß Dieter
Hallo Fusselfrei!
Jetzt kommen wir der Sache schon etwas näher
Also, wenn ich das richtig verstehe, dann steht z.B. "EP000001028882A1" NICHT in einer Zelle und Du möchtest das in eine Input-Box eingeben und in einer ausgewälten Zelle einen Hyperlink in Form "X:\Ordner\EP_1028882_A1.Pdf" einfügen.
Gruß Dieter
Jetzt kommen wir der Sache schon etwas näher
Also, wenn ich das richtig verstehe, dann steht z.B. "EP000001028882A1" NICHT in einer Zelle und Du möchtest das in eine Input-Box eingeben und in einer ausgewälten Zelle einen Hyperlink in Form "X:\Ordner\EP_1028882_A1.Pdf" einfügen.
Gruß Dieter
Hallo Fusselfrei!
Ist das vom letzten Beitrag das Tabellenblatt "Alle Daten" Spalte C?
Gruß Dieter
Ist das vom letzten Beitrag das Tabellenblatt "Alle Daten" Spalte C?
Gruß Dieter
Hallo Roland!
OK, den Code - vermutlich morgen früh - kannst Du dann in den bestehenden Code mit einbinden,sodass er automatisch die Links beim aktualisieren der Liste mit einfügt.
Gruß Dieter
OK, den Code - vermutlich morgen früh - kannst Du dann in den bestehenden Code mit einbinden,sodass er automatisch die Links beim aktualisieren der Liste mit einfügt.
Gruß Dieter
Hallo nochmal!
Doch noch etwas unklar
Wenn: Const ListPaste = "C"
Dann sind mit Paste in Tabelle "Alle Daten" die Spalten C bis J mit der Kopie von Spalte F bis M belegt?
Gruß Dieter
Doch noch etwas unklar
Wenn: Const ListPaste = "C"
Dann sind mit Paste in Tabelle "Alle Daten" die Spalten C bis J mit der Kopie von Spalte F bis M belegt?
Gruß Dieter
Hallo Roland!
Führe folgende Schritte aus:
1. Diese Konstanten anpassen und zu den bisherigen Konstanten hinzufügen
2. Die Codezeile 32 eine Zeile nach unten verschieben und diese Codezeile in Zeile 32 einfügen
3. Diesen Code am Ende des bisherigen Codes anfügen
4. Tabellenblatt "Alle Daten" aktivieren und dann den Cursor auf die Codezeile 1 setzen (Private Sub CreateHyperlinks) und einmal ausführen (Klick blaues Dreieck), um die aktuellen Einträge nachträglich zu initialisieren.
Das war's
Gruß Dieter
PS. Wen's interessiert, dass ist eine Erweiterung von hier: VBA für Excel zum Zusammenführen von Tabellen in Blättern
Edit Biber] Link formatiert. [/Edit]
[Edit Dieter] Danke für's anpassen [/Edit]
Führe folgende Schritte aus:
1. Diese Konstanten anpassen und zu den bisherigen Konstanten hinzufügen
Const LinkCol = "K" 'Spalte mit den Links
Const VNumCol = "C" 'Spalte mit ("EP000000900709B1"...)
Const VNumRng = "C2:C" 'Bereich ab ("EP000000900709B1"...)
Call CreateHyperlinks
Private Sub CreateHyperlinks()
Dim c As Object, i As Integer, s As String, s1 As String, s2 As String, s3 As String
For Each c In Range(VNumRng & GetEndLine(ActiveSheet, VNumCol))
If Len(c) > 3 And IsEmpty(Cells(c.Row, LinkCol)) Then
If IsNumeric(Mid(Right(c, 2), 1, 1)) Then i = 1 Else i = 2
s1 = Left(c, 2) & "_": s2 = Mid(c, 3, Len(c) - 2 - i): s3 = "_" & Right(c, i)
For i = 1 To Len(s2)
If Mid(s2, i, 1) <> "0" Then s2 = Mid(s2, i): Exit For
Next
s = ThisWorkbook.Path & "\" & s1 & s2 & s3 & ".pdf"
ActiveSheet.Hyperlinks.Add Anchor:=Cells(c.Row, LinkCol), Address:=s, TextToDisplay:="Link"
End If
Next
End Sub
Das war's
Gruß Dieter
PS. Wen's interessiert, dass ist eine Erweiterung von hier: VBA für Excel zum Zusammenführen von Tabellen in Blättern
Edit Biber] Link formatiert. [/Edit]
[Edit Dieter] Danke für's anpassen [/Edit]
Hallo Roland!
Freut mich, wenn's trotz umfangreicher Missverständnisse am Ende nun doch funktioniert
Gruß Dieter
Freut mich, wenn's trotz umfangreicher Missverständnisse am Ende nun doch funktioniert
Gruß Dieter