hilfdirselbst.ch
Facebook Twitter gamper-media
pixel66 p
Beiträge: 7
20. Jan 2018, 15:09
Beitrag #1 von 4
Bewertung:
(542 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Sub Replace_From_List()


Hallo zusammen

Ich habe in einem Excel unterschiedliche Inhalte aus dem Explorer (Datei) und einer Datenbank (Prod-ID_alt) zusammengestellt.
Gesamthaft sind das gegen 4800 Dateien in 5 Tabellen.
Die Dateibezeichnungen sind nicht nach Wunsch und müssen umbenannt werde.
Ich möchte das im excel erledigen; so habe ich eine bessere Übersicht.

Gibt’s dazu ein Script? Konnte im Netz noch nichts funktionelles finden.

Ablauf:
Inhalt in Spalte A z.B. «DAS_100391.eps» in der Spalte B suchen.
Entsprechender Eintrag aus Spalte B «PRO_458244_001_DAS_100391.eps» in Spalte C kopieren.

Spalte A: Datei
Spalte B: Prod-ID_alt
Spalte C: Prod-ID_neu ergibt die neue Dateibezeichnung

Vielen Dank für eure Unterstützung

Peter
Top

Anhang:
1.Mappe1.xlsx (9.55 KB)
 
1.Mappe1.png (36.6 KB)
 
X
Klaus79 S
Beiträge: 291
21. Jan 2018, 16:08
Beitrag #2 von 4
Beitrag ID: #561966
Bewertung:
(492 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Sub Replace_From_List()


Hallo Peter,
probier mal:

Code
Sub ReplaceFromList() 
Dim i As Long
Dim lastRow As Long
Dim varSearch As Variant
Dim rng As Range
Dim rngSearch As Range
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

Application.ScreenUpdating = False

For i = 2 To lastRow
varSearch = Range("A" & i)
For Each rng In rngSearch
If InStr(rng, varSearch) > 0 Then
Range("C" & i) = rng.Value
Exit For
End If
Next rng
Next i

Set rng = Nothing
Set rngSearch = Nothing

End Sub

Klappt's?

Gruß
Klaus
als Antwort auf: [#561957] Top
 
pixel66 p
Beiträge: 7
21. Jan 2018, 17:07
Beitrag #3 von 4
Beitrag ID: #561969
Bewertung:
(485 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Sub Replace_From_List()


Hallo Klaus

Dein Script funktioniert tadellos.
Jetzt versuch ich mal den Code zu verstehen; Buch mit sieben Siegeln.

Vielleich brauche ich mal eine Anpassung.

Vielen herzlichen Dank dafür.
Einen schönen Sonntag und guten Wochenstart
Peter
als Antwort auf: [#561966] Top
 
Klaus79 S
Beiträge: 291
22. Jan 2018, 13:33
Beitrag #4 von 4
Beitrag ID: #561980
Bewertung:
(433 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Sub Replace_From_List()


Hallo Peter,

zum besseren Verständnis habe ich Dir mal den Code kommentiert.
Vielleicht bekommst Du dann eine evtl. Anpassung selber gemacht ...

Code
Sub ReplaceFromList() 

'Deklarieren der Variablen:
'Long für Zeilen
'Variant für Suchwort
'Range für Zelle und Zellbereiche

Dim i As Long
Dim lastRow As Long
Dim varSearch As Variant
Dim rng As Range
Dim rngSearch As Range

'Ermitteln der letzten Zeile von Spalte A
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Definieren des Suchbereichs in Spalte B: von Zeile 2 bis letzte Zeile Spalte B
Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)

'Bildschirmflackern ausschalten
Application.ScreenUpdating = False

'Die erste For-Next-Schleife durchsucht Spalte A nach dem 1. Suchwort,
'beginnend bei Zeile 2
For i = 2 To lastRow
'Das Suchwort in die Variable laden
varSearch = Range("A" & i)
'Mit der 2. For-Next-Schleife wird jede Zelle in Spalte B (rngSearch) beginnend
'von Zeile 2 bis Ende Spalte B auf das Suchwort (varSearch) untersucht
For Each rng In rngSearch
'Falls Suchwort gefunden ...
If InStr(rng, varSearch) > 0 Then
'... dann setze den Wert in Spalte C in die gleiche Zeile (i) wie das Suchwort ...
Range("C" & i) = rng.Value
'... und verlasse die innere Schleife ...
Exit For
'Ende der If-Anweisung
End If
'(Ende innere Schleife)
Next rng
' ... und erhöhe die Variable i um 1
'Dann gehe an den Anfang der ersten Schleife und lade
'das nächste Suchwort in die Variable
Next i

'Die Range-Variablen zurücksetzen
Set rng = Nothing
Set rngSearch = Nothing

End Sub

Gruß
Klaus
als Antwort auf: [#561969] Top
 
X