Anzeige
Archiv - Navigation
1408to1412
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
Inhaltsverzeichnis

Mehrere for each Schleifen mit mehreren Bedingunge

Mehrere for each Schleifen mit mehreren Bedingunge
27.02.2015 10:34:44
Sandra
Hallo Forum,
ich versuche mich immer durch googlen und probieren durch VBA zu wühlen. Leider gelingt es mir gerade gar nicht und hoffe auf Hilfe/Unterstützung. Kurz zu meinem Vorhaben. Ich habe mehrere Tabellenblätter und extrem viele Daten, die nur durch Zuordnungen mit IDs klappt, da einige Daten zu mehreren Personen zugeordnet werden können. D.h. es ist keine 1 zu 1 Zuordnung.
Das ist so ein Versuch von mir es zu lösen. Entschuldigt bitte. Ich weiß, dass es schlecht ist, aber ich wollte nicht mit "leeren Händen" nach Hilfe suchen..
Sub WerteZuordnung()
Dim wksZuordnungsSheet As Worksheet
Dim wksPersonen As Worksheet
Dim wksEigenschaften As Worksheet
Dim ZelleEigenschaftenZuordnen As Range
Dim ZelleZuordnung As Range
Dim ZelleEigenschaften As Range
Dim Variable As Variant
Dim Variable2 As Variant
Dim Variable3 As Variant
' Fehlermeldungen, Events und Bildschirmaktualisierung deaktivieren
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' D4 bis D100 nach Eintragungen absuchen
For Each ZelleEigenschaftenZuordnen In Sheets("2. Eigenschaften zuordnen").Range("D4:D100")
' Wenn Zelle nicht leer, dann den Wert in "Variable" speichern
If ZelleEigenschaftenZuordnen  "" Then
ZelleEigenschaftenZuordnen.Value = Variable
End If
' B4 bis B8584 absuchen, ob der bereits gefundene Wert mit einem in dieser Spalte "matcht"
For Each ZelleZuordnung In Sheets("IV.Zuordnung").Range("B4:B8584")
ElseIf ZelleZuordnung.Value = ZelleEigenschaftenZuordnen.Value Then
' In Variable2 den Wert eine Zelle daneben speichern
Variable2 = ZelleZuordnung.Offset(0, 1).Value
End If
' E4 bis E567 absuchen, ob der Wert vorher mit einem in dieser Spalte "matcht"
For Each ZelleEigenschaften In Sheets("II.Eigenschaften").Range("E4:E567")
ElseIf ZelleEigenschaften.Value = ZelleEigenschaftenZuordnen.Value Then
' Wert dieser Zelle kopieren
ZelleEigenschaftenZuordnen.Value.Copy
End If
wksZuordnungsSheet.Activate
' Falls die Zelle daneben leer ist, hier einfügen
ElseIf ZelleEigenschaftenZuordnen.Offset(0, 1)  "" Then
wksMappingThreats.ZelleEigenschaftenZuordnen.Offset(0, 1).Paste
' Wenn die Zelle schon besetzt ist, Zeile darunter einfügen und Wert einfügen
Else
ZelleEigenschaftenZuordnen.Rows.Insert
wksZuordnungsSheet.ZelleEigenschaftenZuordnen.Offset(0, 1).Paste
End If
Next ZelleEigenschaftenZuordnen
Next ZelleZuordnung
Next ZelleEigenschaften
' Fehlermeldungen, Events und Bildschirmaktualisierung deaktivieren
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere for each Schleifen mit mehreren Bedingunge
27.02.2015 12:52:09
fcs
Hallo Sandra,
dein Makroversuch ist leider etwas zu chaotisch geraten, so dass man nicht genau nachvolziehen kann wie die If-ElseIf-EndIf verschachtelt werden sollen.
Könntest du eine Beispieldatei (Namen anaonym machen) mit 10 bis 20 typischen Datenzeilen in jedem Tabellenblatt, so dass das Makro auch alle möglichen Aktionen ausführen muss.
Auf einem separaten Blatt bescheibe den Makroablauf nochmals, insbesondere in der 3. For-Next-Schleife, was kopiert und wo eingefügt werden soll.
Gruß
Franz

AW: Mehrere for each Schleifen mit mehreren Bedingunge
27.02.2015 13:15:38
ChrisL
Hi Sandra
Ich hatte den gleichen Gedanken wie fcs, eine Beispieldatei wäre hilfreich. Dennoch ist mir etwas aufgefallen.
ZelleEigenschaftenZuordnen.Value = Variable
Variable2 = ZelleZuordnung.Offset(0, 1).Value
Ich meine du müsstest umkehren
' übergibt den Zellwert in die Variable
Variable = ZelleEigenschaftenZuordnen.Value
' schreibt die Variable in die Zelle
ZelleZuordnung.Offset(0, 1).Value = Variable2
cu
Chris

Anzeige
AW: Mehrere for each Schleifen mit mehreren Bedingunge
04.03.2015 13:13:15
Sandra
Hallo nochmal,
danke für die Antworten. Ich habe eine Zip Datei fertig gemacht, kann sie aber nicht hochladen...
"Ungültiger Dateiname", jedoch beachte ich alle Hinweise.
Kann mir jemand einen Tipp geben wie ich die Datei sonst hochladen soll?
Danke und Grüße

AW: Mehrere for each Schleifen mit mehreren Bedingunge
04.03.2015 16:00:12
fcs
Hallo Sandra,
mit Verzeichnis kurz und Dateiname kurz und alles ohne Leerzeichen und auch ohne Sonderzeichen (z.B. ä ö ü ß) sollte es funktionieren, wenn die Größe (&lt 300 kByte).
Gruß
Franz
ansonsten kannst du auch versuchen die Datei an die E-Mail-Adressen in meinenm Profil zu schicken.

Anzeige
AW: Mehrere for each Schleifen mit mehreren Bedingunge
05.03.2015 16:28:45
fcs
Hallo Sandra,
endlich bin ich durch das Puzzlespiel.
Leider hat die Schaltfläche im Blatt "2. Bereichszuordnung" irgendeine komische Macke und Excel stürzt sofort ab, wenn man versucht sie zulöschen. Ich musste das Blatt neu aufbauen und dann alle Blätter außer dem Schrottblatt in eine neue Mappe kopieren.
Zusätzlich hab ich die Auswahllisten im Blatt "List" und damit verbundene DropDown-Auswahlen in den Tabellen optimiert.
Ich hoffe, dass die Ausführungsgeschwindigkeit auch in der echten Datei akzeptabel ist. Wenn nicht, dann müßte man alle Daten in Arrays verwalten, um auf Tempo zu kommen.
Gruß
Franz
https://www.herber.de/bbs/user/96181.zip
Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige