Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
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 11:07:42
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


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
  • 27.02.2015 11:12:22
    Hajo_Zi
Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige