Hallo Forum,
möchte folgendes mittels VBA Code bewerkstelligen.
In der Tab Plan wird in Zelle B1 ein Datum eingegeben.
Das Datum wird in Tab Bsp. November in der N (hier N2) gefunden und Fundzelle wird ausgegeben:
VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsMon As Worksheet, lngC As Long
If Not Target.Address(0, 0) = "B1" Then Exit Sub
If Not IsDate(Target) Then MsgBox "Kein Datum - Abbruch": Exit Sub
Set wsMon = Sheets(Format(Target, "mmmm")) ' Tabellenblatt mit dem Monat
lngC = Day(Target) + 4 ' Spalte mit dem Tag
MsgBox "Das eingegebene Datum steht in Blatt '" & wsMon.Name _
& "' in Zelle " & Cells(2, lngC).Address
End Sub
Das klappt auch so.
Nun möchte ich weiter, dass verglichen wird was in Tab Plan in den Zellen D1, E1 und F1 steht und aus der Fundspalte (hier: N) bei Treffer die Werte aus Tab Monat: hier Spalte A, B, C, D und der Wert aus der Spalte des Tages in die Tab Plan übertragen werden in Spalte A-E.
Ist das möglich, oder denke ich da zu kompliziert und es gibt einen einfacheren Weg?
Als Beispiel habe ich mal die Datei mit angefügt.
Danke für Eure Unterstützung, wenn es denn machbar ist.
Gruß Micha
[
attachment=14129]
Hallo Micha,
klingt erst mal gut. Du müsstest aber noch überlegen, mit was Du vergleichen willst und welche Zeilen / Zellen Du genau aus der Fundspalte und der Tabelle Monat Du brauchst und wo die Spalte des Tages genau ist.. Ich vermute mal, das ist auch N, wäre noch die Frage, auf welchem Blatt.
Hallo schauan,
erstmal Danke für deine Antwort...
Dachte schon das keiner etwas damit anfangen kann.
Gesucht werden soll dann natürlich immer in der Fundspalte des gefundenen Datum.
Die Werte aus der Fundspalte sollen dann verglichen werden mit den Werten aus der TabPlan, Zellen D1, E1 und F1.
Sobald der Vergleich passt aus der Spalte des Datum, dann die Werte aus den Zellen A, B, C und D und aus der Datumspalte kopieren und in TabPlan untereinander in Spalte A, B, C, D und E einfügen.
Sollte eigentlich in der Musterdatei die hier mit angefügt ist ersichtlich sein. Wenn nicht, dann kann ich ja noch eine einfache, übersichtlichere Datei hochladen.
Danke und Gruß
Guten Morgen zusammen,
habe jetzt durch viel Probieren und Testen eine Möglichkeit gefunden das mir die Werte in die TAB Plan kopiert:
hier die Anweisung:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsMon As Worksheet, lngC As Long, arD, arA, arB, arP, arZ, qq As Long
Dim arE(), arF(), ee As Long, ff As Long, bolPr As Boolean
If Not Target.Address(0, 0) = "B1" Then Exit Sub
If Not IsDate(Target) Then MsgBox "Kein Datum - Abbruch": Exit Sub
Set wsMon = Sheets(Format(Target, "mmmm")) ' Tabellenblatt mit dem Monat
lngC = Day(Target) + 4 ' Spalte mit dem Tag
arD = wsMon.Cells(8, lngC).Resize(447) ' Werte Spalte des Tages
arA = wsMon.Cells(8, 1).Resize(447) ' Werte Spalte A
arB = wsMon.Cells(8, 2).Resize(447) ' Werte Spalte B
arP = wsMon.Cells(8, 3).Resize(447) ' Werte Spalte C
arZ = wsMon.Cells(8, 4).Resize(447) ' Spalte D
ReDim arE(1 To UBound(arD), 8)
ReDim arF(1 To UBound(arD), 8)
For qq = 1 To UBound(arD)
Select Case arD(qq, 1)
Case "" ' leer
Case Is = Worksheets("Plan").Range("D1").Value
' in D1 steht der Wert/ String
ee = ee + 1
arE(ee, 0) = arA(qq, 1)
arE(ee, 1) = arB(qq, 1)
arE(ee, 2) = arP(qq, 1)
arE(ee, 3) = arD(qq, 1)
arE(ee, 6) = arZ(qq, 1)
End Select
Next qq
With Sheets("Plan") ' Ausgabe in Blatt "Plan" - muss existieren
.Range("A7:D150").ClearContents
.Range("G7:G150").ClearContents
.Cells(7, 1).Resize(ee, 7) = arE ' primäre
.Activate ' falls Blatt Vorlage aktiv sein soll
End With
End Sub
Macht das was er soll.
Jedoch habe ich noch das Problem, dass jetzt nur verglichen wird was in Zelle D1 und im TAB Monat in der Fundspalte steht. Also wenn in D1 zB ein "F" steht wird alles aus der Fundspalte kopiert wo auch ein F steht.
Brauche aber noch, dass mehrere Bedingungen kopiert werden.
Eventuell hat jemand jetzt eine Idee?
Gruß
Hallo Micha,
soll statt nach F noch nach was anderem gesucht werden oder soll in einer anderen Spalte noch nach F gesucht werden oder ...?
Mit Select Case bekommst Du nur einen Treffer verarbeitet.
Wenn Du mehrere If nacheinander nimmst, gehen mehrere.
Hier mal was zur Theorie:
Code:
Sub test()
a = 2
Select Case a
Case 2
MsgBox 1
Case 4 / 2
MsgBox 2
End Select
End Sub
Das wird Dir nur die 1 ausgeben.
Code:
Sub test()
a = 2
If a = 2 Then MsgBox 1
If a = 4 / 2 Then MsgBox 2
End Sub
Hier bekommst Du beide Meldungen
Select Case oder If kannst Du auch verwenden, wenn Du in mehreren Spalten oder verschiedenen Daten suchst, im Prinzip
Code:
Sub test()
a = 2
Select Case a
Case 2 / 2 And 4 / 2
MsgBox 1
Case 2 / 1 And 4 / 2
MsgBox 2
End Select
End Sub
Hallo schauan,
gesucht wird immer nur in der einen Spalte mit dem eingegebenen Datum.
Das wonach gesucht werden soll ist etwas schwierig zu beschreiben. Versuche es mal:
Es geht eigentlich um eine Dienstplanung.
Eingabe Datum, Eingabe der Schicht, bsp. F für Früh
Es wird wie schon erwähnt das Datum gesucht, gefunden in einer Zelle bsp, N2 und alles was darunter kommt sind dann die eingetragenen Schichten.
So wie es jetzt ist wird nur nach F gesucht.
Da es aber noch andere Schichten während der Frühschicht gibt mit anderen Anfangs- und Endzeiten möchte ich bewirken, dass auch nach diesen Schichten gesucht wird.
bsp. Früh Anfang 6:00 Ende 14:00
F1 Anfang 6:30 Ende 14:30 usw.
Mit 'Case "F", "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12", "F13", "S1", "S2" findet der Code auch all die geannten Schichten.
Das gilt nur für die Frühschicht und es gibt ja auch noch Spät und Nacht, und da weiß ich nicht wie ich das bewerkstelligen soll. Kann natürlcih alle Schichten in Case eintragen aber dann hat man ja nicht die differenzierung zw. Früh und Überlappung, Spät und Überlappung und Nacht und Überlappung.
Hatte so eine Idee:
Bsp.: Konstante oder Variable oder was geht:
Case Früh
Früh = F, F1, F2, F3, S1, S2, Ü1, Ü2 usw
Case Spät
Spät = S, S1, S2, S3, S4, Ü2, Ü3, A3, A5 usw
Case Nacht
Nacht = N, N1, N2, N3, N4, N5, S4, S5, S6, Ü10 usw
und dann in der Abfrage:
Select Case arD(qq, 1)
Case "" ' leer
Case Is = Worksheets("Plan").Range("D1").Value ' und da steht dann zB Früh oder F, Spät oder S, Nacht oder N und bezieht sich dann auf Case Früh, Case Spät, Case Nacht??
Geht sowas?
Danke und Gruß Micha63
Hallo Micha,
dann würde ich lieber mit If arbeiten, z.B.
If arD(qq, 1) Like "F*" Then ...
und damit hättest Du alle Fälle, die mit F beginnen, abgedeckt.
Wenn Du D1 berücksichtigen willst eventuell so
If arD(qq, 1) Like Left(Worksheets("Plan").Range("D1").Value,1) & "*" Then ...
Damit ist es egal, ob dort F oder Früh steht.
Wenn Du aber bei Früh alles haben willst und ansonsten F1 oder F2, je nachdem, was dort steht, muss man es eventuell in 2 Stufen machen, wenn Früh alle F's betreffen soll.
Wenn da nicht nur F's berücksichtigt werden sollen sondern auch U10 oder was auch immer, kannst Du auch ein Array bilden und das in einer zusätzlichen "inneren" Schleife abarbeiten.
Im Prinzip so, und für die anderen Schichten analog:
Code:
Sub test()
Dim a$, arrSchichtF, iCnt%
a = "U10"
arrSchichtF = Array("F1", "F2", "U10")
For iCnt = 0 To UBound(arrSchichtF)
If a = arrSchichtF(iCnt) Then MsgBox "Das war " & iCnt
Next
End Sub
Man könnte da auch ein 2D-Array nehmen wo man noch die Schicht in der zusätzlichen Dimension verdrahtet und dann gezielt steuert, welche Schicht man durchlaufen will.
Hallo schauan,
vielen Dank für deine Unterstützung
das hier klingt und sieht für mich so aus als müsste es passen:
Zitat:Wenn da nicht nur F's berücksichtigt werden sollen sondern auch U10 oder was auch immer, kannst Du auch ein Array bilden und das in einer zusätzlichen "inneren" Schleife abarbeiten.
Im Prinzip so, und für die anderen Schichten analog:
Code:
Sub test()
Dim a$, arrSchichtF, iCnt%
a = "U10"
arrSchichtF = Array("F1", "F2", "U10")
For iCnt = 0 To UBound(arrSchichtF)
If a = arrSchichtF(iCnt) Then MsgBox "Das war " & iCnt
Next
End Sub
Jetzt habe ich das Problem:
1. wie erweitere ich das für die anderen Schichten?
Dim a$, arrSchichtF, arrSchichtS, arrSchichtN, arrSchichtT, iCnt%
arrSchichtF = Array("F", "F1", "F2", "A1", "Ü1")
arrSchichtS = Array("S", "S1", "S2", "S3", "A8")
arrSchichtN = Array("N", "N1", "N2", "NL")
arrSchichtT = Array("T", "T1", "T2", "A2")
For iCnt = 0 To UBound(arrSchichtF)
For iCnt = 0 To UBound(arrSchichtS)
For iCnt = 0 To UBound(arrSchichtN)
For iCnt = 0 To UBound(arrSchichtT)
Next
End Sub
2. wie baue ich das dann in meinen bestehenden Code ein?
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsMon As Worksheet, lngC As Long, arD, arA, arB, arP, arZ, qq As Long
Dim arE(), arF(), ee As Long, ff As Long, bolPr As Boolean
If Not Target.Address(0, 0) = "B1" Then Exit Sub
If Not IsDate(Target) Then MsgBox "Kein Datum - Abbruch": Exit Sub
Set wsMon = Sheets(Format(Target, "mmmm")) ' Tabellenblatt mit dem Monat
lngC = Day(Target) + 4 ' Spalte mit dem Tag
arD = wsMon.Cells(8, lngC).Resize(447) ' Werte Spalte des Tages
arA = wsMon.Cells(8, 1).Resize(447) ' Werte Spalte A
arB = wsMon.Cells(8, 2).Resize(447) ' Werte Spalte B
arP = wsMon.Cells(8, 3).Resize(447) ' Werte Spalte C
arZ = wsMon.Cells(8, 4).Resize(447) ' Spalte D
ReDim arE(1 To UBound(arD), 8)
ReDim arF(1 To UBound(arD), 8)
For qq = 1 To UBound(arD)
Select Case arD(qq, 1)
Case "" ' leer
Case Is = Worksheets("Plan").Range("D1").Value
' in D1 steht der Wert/ String
ee = ee + 1
arE(ee, 0) = arA(qq, 1)
arE(ee, 1) = arB(qq, 1)
arE(ee, 2) = arP(qq, 1)
arE(ee, 3) = arD(qq, 1)
arE(ee, 6) = arZ(qq, 1)
End Select
Next qq
With Sheets("Plan") ' Ausgabe in Blatt "Plan" - muss existieren
.Range("A7:D150").ClearContents
.Range("G7:G150").ClearContents
.Cells(7, 1).Resize(ee, 7) = arE ' primäre
.Activate ' falls Blatt Vorlage aktiv sein soll
End With
End Sub
Hallo Zusammen,
möchte das Thema nochmal nach oben holen.
Ich habe es bis heute leider noch nicht zu m laufen gebracht.
Daher bleibt und ist meine Anfrage weiterhin offen und ich hoffe das sich vielleicht schauan diesem nochmal widmet...
Gruß Micha
Hallo Micha,
da hab ich bestimmt eine Benachrichtigung zu viel gelöscht oder keine bekommen
also so wird es eher nix.
For iCnt = 0 To UBound(arrSchichtF)
For iCnt = 0 To UBound(arrSchichtS)
For iCnt = 0 To UBound(arrSchichtN)
For iCnt = 0 To UBound(arrSchichtT)
Next
wenn, dann so
For iCnt = 0 To UBound(arrSchichtF)
Next
For iCnt = 0 To UBound(arrSchichtS)
Next
For iCnt = 0 To UBound(arrSchichtN)
Next
For iCnt = 0 To UBound(arrSchichtT)
Next
Je nachdem, ob ich Deinen Code richtig verstanden habe, könnte es so sein:
Code:
For qq = 1 To UBound(arD)
For iCnt = 0 To UBound(arrSchichtF)
If arrSchichtF(iCnt) = Worksheets("Plan").Range("D1").Value Then
ee = ee + 1
arE(ee, 0) = arA(qq, 1)
arE(ee, 1) = arB(qq, 1)
arE(ee, 2) = arP(qq, 1)
arE(ee, 3) = arD(qq, 1)
arE(ee, 6) = arZ(qq, 1)
Exit For
End If
Next iCnt
Next qq
Je nachdem, wie die Reihenfolge im arE sein soll, müsstest Du die anderen Schichten innerhalb der qq Schleife analog F der Reihe nach programmieren oder Du brauchst die qq Schleifen entsprechend oft