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

VBA in Excel zum Umbenennen von Strings

Frage Entwicklung VB for Applications

Mitglied: Fusselfrei

Fusselfrei (Level 1) - Jetzt verbinden

22.09.2009, aktualisiert 18.10.2012, 6422 Aufrufe, 20 Kommentare

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
Mitglied: lippoliv
22.09.2009 um 10:23 Uhr
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
Bitte warten ..
Mitglied: 76109
22.09.2009 um 12:15 Uhr
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
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 15:45 Uhr
Hallo Dieter,

am Anfang kommen immer zwei Buchstaben vor.
Eine einfache Möglichkeit der Codeanpassung (für einen Anfänger wie mich), wieviele "0"in Abhängigkeit von den ersten 2 Buchstaben abgeschnitten werden, wäre fein!

Am Ende können 2 Fälle auftreten:

a) nur ein Buchstabe
b) ein Buchstabe und eine Ziffer

Ihr seid solche Profis und Eure Hilfe ist unglaublich!! Vielen herzlichen Dank!

Womit kann ich Einsteiger mir denn VBA gut aneignen, damit ich später auch Anderen helfen könnte?

Grüße
Fussefrei
Bitte warten ..
Mitglied: 76109
22.09.2009 um 16:20 Uhr
Hallo Fusselfrei!

Zitat von Fusselfrei:
am Anfang kommen immer zwei Buchstaben vor.
Wieviel verschiedene Kombinationen soll's am Anfang geben z.B. >10, >20...?

Gruß Dieter
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 16:36 Uhr
Hallo Dieter,

theoretisch sind knapp 100 möglich,
praktisch sind es aber evtl. 15, denn viele kann man zusammenfassen.

Grüße
Fusselfrei
Bitte warten ..
Mitglied: MonoTone
22.09.2009 um 17:09 Uhr
Ich würde es so machen:

01.
Function KillZero(ByVal Str As String) As Integer 
02.
Select Case Str 
03.
Case "EP" 
04.
KillZero = 5 
05.
Case "DE" 
06.
KillZero = 4 
07.
'Case "Bl" .... 
08.
End Select 
09.
 
10.
End Function 
11.
 
12.
Sub Main() 
13.
Dim Str As String 
14.
Str = InputBox("Stringeingabe") 
15.
FirstTwo = Left(Str, 2) 
16.
LastTwo = Right(Str, 2) 
17.
cutnull = KillZero(FirstTwo) 
18.
LenMid = Len(Str) - 4 - cutnull 
19.
Middle = Mid(Str, 3 + cutnull, LenMid) 
20.
Res = FirstTwo & "_" & Middle & "_" & LastTwo 
21.
MsgBox Res 
22.
End Sub
Bitte warten ..
Mitglied: 76109
22.09.2009 um 17:13 Uhr
Hallo Fusselfrei!

Heute ist zwar kein Montag, aber irgendwie steh ich auf'm Schlauch

Zitat von Fusselfrei:
praktisch sind es aber evtl. 15, denn viele kann man zusammenfassen.
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
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 17:50 Uhr
Zitat von 76109:

Heute ist zwar kein Montag, aber irgendwie steh ich auf'm
Schlauch

Entschuldigung, das geht mir heute genauso!
Meine Frage war nicht richtig und ich habe einen Fehler gemacht. Dafür möchte ich mich entschuldigen!

1) nach den ersten zwei Buchstaben soll ein "_" eingefügt werden,
2) alle "0" nach den ersten zwei Buchstaben sollen gelöscht werden,
3) nach der letzten Ziffer (vor dem darauf folgenden Buchstaben) soll ein "_" eingefügt werden
( nach den Ziffern können am Ende ein Buchstabe oder ein Buchstabe und eine Ziffer stehen)

- - - - - - - - -
Zum Hintergrund meiner zuvor falschen Frage:

Ich recherchiere nach Patentschriften, wobei mir das DPMA (Deutsche Patent und Markenamt) zu einem Treffer einen Dokumentnamen wie z.B.
EP000001028882A1
liefert, wobei ich diesen Dokumentenname in Excel übernehme.

Ich verwende ein Tool zum Downloaden der gefundenen Patentschriften, wobei die heruntergeladenen Patentschriften ein Format wie z.B. EP_1028882_A1.pdf haben.

Das Download-Tool hat mir mit 2 Ausnahmen (von 470 Dokumenten) eine Schrift im Format wie EP_0900709_A3 geladen (d.h. nach EP steht noch eine "0" - warum weiß ich noch nicht...)
- - - - - - - - -

4) In meinem Excel-Sheet möchte ich danach einen Link auf die PDF-Datei setzen lassen (wie weiss ich noch nicht).
Daher muss ich zuvor den Dokumentnamen in der Excel-Datei ändern.
D.h. von z.B. XX000123456YY in XX_123456_YY oder
aus z.B. XX00098765Y1 in XX_00098765_Y1, damit Dateiname in Excel mit dem Dateiname der PDF-Datei übereinstimmt.

Grüße
ein sich schämender
Fusselfrei
Bitte warten ..
Mitglied: 76109
22.09.2009 um 18:34 Uhr
Hallo Fusselfrei!

Zitat von Fusselfrei:
ein sich schämender
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
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 18:49 Uhr
Hallo Dieter,

in einer Zelle der Liste steht z.B. "EP000001028882A1" und in einer anderen Zelle in der gleichen Spalte (in welcher Zeile weiss ich noch nicht) soll dann der Link "X:\Ordner\EP_1028882_A1.Pdf" stehen, damit ich mit dem Link die Datei in Acrobat öffnen kann.

Die Excel-Datei steht im gleichen Verzeichnis wie die pdf-Datei, weil ich mich nicht auf einen absoluten Pfad "X:\Ordner\" festlegen möchte.

Grüße
Fusselfrei
Bitte warten ..
Mitglied: 76109
22.09.2009 um 19:20 Uhr
Hallo Fusselfrei!

Ist das vom letzten Beitrag das Tabellenblatt "Alle Daten" Spalte C?

Gruß Dieter
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 19:44 Uhr
Hallo Dieter!

Ja genau,

ich habe die Start-Zellen Position und Länge angepasst:

Const CopyRng = "F22" 'Kopieren Zelle 1
Const CopyBeg = "F" 'Kopieren Spalte 1
Const CopyEnd = "M" 'Kopieren Spalte n

mit
.Value = Array("Lfd.-Nr.", "Blattname", "Veroeffentlichungs-Nummer", "Anmeldedatum", "Veröffentlichungsdatum", "IPC-Hauptklasse", "Erfinder", "Anmelder", "Titel", "Pruefstoff-IPC")
.HorizontalAlignment = xlCenter

Spalte E im Blatt "Alle Daten"als "Ziel" für den neuen Link wäre fein.

Grüße
Roland
Bitte warten ..
Mitglied: 76109
22.09.2009 um 20:00 Uhr
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
Bitte warten ..
Mitglied: Fusselfrei
22.09.2009 um 20:11 Uhr
Hallo Dieter!

Vielen lieben Dank!

Grüße
Roland
Bitte warten ..
Mitglied: 76109
22.09.2009 um 22:05 Uhr
Hallo nochmal!

Doch noch etwas unklar

Zitat von Fusselfrei:
Spalte E im Blatt "Alle Daten"als "Ziel" für den neuen Link wäre fein.
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
Bitte warten ..
Mitglied: 76109
22.09.2009, aktualisiert 18.10.2012
Hallo Roland!

Führe folgende Schritte aus:
1. Diese Konstanten anpassen und zu den bisherigen Konstanten hinzufügen
01.
Const LinkCol = "K"             'Spalte mit den Links 
02.
Const VNumCol = "C"             'Spalte mit ("EP000000900709B1"...) 
03.
Const VNumRng = "C2:C"          'Bereich ab ("EP000000900709B1"...)
2. Die Codezeile 32 eine Zeile nach unten verschieben und diese Codezeile in Zeile 32 einfügen
01.
Call CreateHyperlinks
3. Diesen Code am Ende des bisherigen Codes anfügen
01.
Private Sub CreateHyperlinks() 
02.
    Dim c As Object, i As Integer, s As String, s1 As String, s2 As String, s3 As String 
03.
 
04.
    For Each c In Range(VNumRng & GetEndLine(ActiveSheet, VNumCol)) 
05.
        If Len(c) > 3 And IsEmpty(Cells(c.Row, LinkCol)) Then 
06.
            If IsNumeric(Mid(Right(c, 2), 1, 1)) Then i = 1 Else i = 2 
07.
     
08.
            s1 = Left(c, 2) & "_":  s2 = Mid(c, 3, Len(c) - 2 - i):  s3 = "_" & Right(c, i) 
09.
     
10.
            For i = 1 To Len(s2) 
11.
                If Mid(s2, i, 1) <> "0" Then s2 = Mid(s2, i):  Exit For 
12.
            Next 
13.
     
14.
            s = ThisWorkbook.Path & "\" & s1 & s2 & s3 & ".pdf" 
15.
             
16.
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(c.Row, LinkCol), Address:=s, TextToDisplay:="Link" 
17.
        End If 
18.
    Next 
19.
End Sub
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]
Bitte warten ..
Mitglied: Fusselfrei
23.09.2009 um 20:16 Uhr
Hallo Dieter,

vielen herzlichen Dank! Es klappt einwandfrei!

Grüße
Roland
Bitte warten ..
Mitglied: Fusselfrei
23.09.2009 um 20:18 Uhr
Hallo MonoTone,

vielen Dank für Deinen Vorschlag!

Grüße
Fusselfrei
Bitte warten ..
Mitglied: Fusselfrei
23.09.2009 um 20:21 Uhr
Zitat von lippoliv:
Das sieht mir verdächtig nach Schulaufgabe auf...

Ja, ich muss noch viel lernen

Vielen Dank für Deinen Ansatz!

Grüße
Fusselfrei
Bitte warten ..
Mitglied: 76109
23.09.2009 um 20:42 Uhr
Hallo Roland!

Freut mich, wenn's trotz umfangreicher Missverständnisse am Ende nun doch funktioniert

Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
gelöst Verschieben von Zellinformation in andere Spalte (per VBA) excel 2010 (5)

Frage von thomas1972 zum Thema Microsoft Office ...

VB for Applications
Bilder vom LDAP in VBA - Excel (3)

Frage von Roadrunner777 zum Thema VB for Applications ...

VB for Applications
gelöst VBA Excel Recordset - Abfrage auf SQL-Server (4)

Frage von Aximand zum Thema VB for Applications ...

VB for Applications
Excel VBA Sortierung von Daten (5)

Frage von easy4breezy zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...