Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1872to1876
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ständige Wiederholungen vermeiden

Ständige Wiederholungen vermeiden
15.03.2022 11:19:31
Andy
Hallo Forum Team,
ich habe ein Frage zu einem Makro. Unten wäre der Code eingegeben.
Wie kann ich die ständigen Wiederholungen vermeiden?
Ich habe ca. 200 dieser Angaben und will den Code nicht 200x kopieren
If MyFile Like "*A*" Then
Workbooks("Kosten").Worksheets("DE").Range("C13").PasteSpecial xlPasteValues
End If
If MyFile Like "B*" Then
Workbooks("Kosten").Worksheets("DE").Range("C14").PasteSpecial xlPasteValues
End If
If MyFile Like "*C*" Then
Workbooks("Kosten").Worksheets("DE").Range("C15").PasteSpecial xlPasteValues
End If
If MyFile Like "*D*" Then
Workbooks("Kosten").Worksheets("DE").Range("C16").PasteSpecial xlPasteValues
End If
If MyFile Like "*E*" Then
Workbooks("Kosten").Worksheets("DE").Range("C17").PasteSpecial xlPasteValues
End If
If MyFile Like "*F*" Then
Workbooks("Kosten").Worksheets("DE").Range("C18").PasteSpecial xlPasteValues
End If

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ständige Wiederholungen vermeiden
15.03.2022 11:45:02
Luschi
Hallo Andy,
bei mir sieht das so aus: 

Sub test1()
Dim suchWerte As String, vArr As Variant, _
i As Integer
suchWerte = "A*B*C*Ich*Du*Er*Sie*Es*Wir*Ihr*Alle"
vArr = Split(suchWerte, "*", -1, vbTextCompare)
'i ist nullbassiert, deshalb 13 + i
For i = LBound(vArr) To UBound(vArr)
With Workbooks("Kosten").Worksheets("DE")
''Debug.Print .Range("C" & (13 + i)).Address
If MyFile Like "*" & vArr(i) & "*" Then
.Range("C" & (12 + i)).PasteSpecial xlPasteValues
End If
End With
Next i
If VarType(vArr) >= vbArray Then
Erase vArr
End If
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: kleine Korrektur
15.03.2022 11:49:53
Luschi
Hallo Andi,
wenn man im Kommentar schon darauf hinweist, sollte es im Code auch stehen:
.Range("C" & (13 + i)).PasteSpecial xlPasteValues
Gruß von Luschi
aus klein-Paris
AW: Ständige Wiederholungen vermeiden
15.03.2022 21:50:05
Yal
Moin,
basierend auf die schon vollständige Lösung von Luschi, schlage ich meine Senf vor (es gibt zurzeit zu wenige Frage für zu viele Antwortenden ;-)

Sub test1()
Dim WennDann As String
Dim WasWo
Const cWennDanns = "*A*>C13,*B*>C14,*C*>C15,*D*>C16,*E*>C17,*F*>C18"
For Each WennDann In Split(cWennDanns, ",")
WasWo = Split(WennDann, ">")
If MyFile Like WasWo(0) Then Workbooks("Kosten").Worksheets("DE").Range(WasWo(1)).PasteSpecial xlPasteValues
Next
End Sub
Aber wie gesagt, es ist nichts anderes als die Lösung von Luschi, nur anders zusammengestellt.
Das einzige Vorteil besteht in der Übersicht der Zusammenhang der "Wenn" zu den "Dann" und die Einfachheit, diese umzugestalten, falls notwendig.
VG
Yal
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige