Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1160to1164
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

For Each ... Next" ?

For Each ... Next" ?
Djalil
Guten Morgen zusammen,
Kann mir jemand bitte helfen? Der folgende Code funktioniert nicht:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rBereich_1, rBereich_2 As Range
Dim rZelle1, rZelle2 As Range
Set rBereich_1 = Range("B4:B34")
Set rBereich_2 = Range("C4:C34")
For Each rZelle2 In rBereich_2
For Each rZelle1 In rBereich_1
If Range("B35").Value = "X" Then
Sheets("Stundennachweis").Range("C10:C40") = Mid(rZelle1, 1, 5)
Sheets("Stundennachweis").Range("D10:D40") = Mid(rZelle1, 9, 5)
Sheets("Stundennachweis").Range("E10:E40") = Mid(rZelle1, 15, 100)
If Range("C35").Value = "X" Then
Sheets("Stundennachweis").Range("C10:C40") = Mid(rZelle2, 1, 5)
Sheets("Stundennachweis").Range("D10:D40") = Mid(rZelle2, 9, 5)
Sheets("Stundennachweis").Range("E10:E40") = Mid(rZelle2, 15, 100)
End If
End If
Next rZelle1
Next rZelle2
End Sub

Vielen Dank für die Hilfe
VG
Ahmadian

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: For Each ... Next" ?
14.06.2010 12:43:33
Rudi
Hallo,
sorry, aber für mich sieht das ziemlich blödsinnig aus.
Warum willst du C10:E40 31x mit irgendwelchen Werten überschreiben?
Gruß
Rudi
AW: For Each ... Next" ?
14.06.2010 12:44:14
BoskoBiati
Hallo,
"Meister, mein Auto geht nicht"!
Was macht der Code, bzw was macht er nicht?
Das:

Dim rBereich_1, rBereich_2 As Range
ist nicht schön, es sollte besser so lauten:
Dim rBereich_1 as range, rBereich_2 As Range

Ebenso in der nächsten Zeile.
Wo steht der Code, wie heißen die Tabellen?
Was soll der Code machen?
Gruß
Bosko
Anzeige
AW: For Each ... Next" ?
14.06.2010 13:42:48
Djalil
Hallo BoskoBiati,
der Code steht in Tabelle3 "Dienstplan"
der Code soll folgendes machen:
in Zellen B4:B34 steht: 06:00 - 18:00 TO
wenn in B35 ein x steht, die ersten 5 Zeichen "06:00" in die Zellen C10:C40 und die nächsten 5 Zeichen "18:00" in die Zellen D10:D40 und die letzten 2 Zeichen "TO" in die Zellen E10:E40 kopieren/eintragen.
ich hoffe dass ich meine Problem richtig beschrieben habe.
VG
Ahmadian
vielleicht so?
14.06.2010 14:25:19
Erich
Hi Ahmadian,
ist das vielleicht so gemeint?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrQ, arrE(), ii As Long
If Cells(35, 2).Value = "X" Then
arrQ = Application.Transpose(Range("B4:B34"))
ElseIf Cells(35, 3).Value = "X" Then
arrQ = Application.Transpose(Range("C4:C34"))
Else
Exit Sub
End If
ReDim arrE(1 To UBound(arrQ), 1 To 3)
For ii = 1 To UBound(arrQ)
arrE(ii, 1) = Mid(arrQ(ii), 1, 5)
arrE(ii, 2) = Mid(arrQ(ii), 9, 5)
arrE(ii, 3) = Mid(arrQ(ii), 15, 100)
Next ii
Application.EnableEvents = False
Sheets("Stundennachweis").Cells(10, 3). _
Resize(UBound(arrE), UBound(arrE, 2)) = arrE
Application.EnableEvents = True
End Sub
Eines ist noch sehr fraglich:
Die Routine läuft immer los, wenn sich auf dem Blatt ein Wert ändert - auch wenn die Änderung
z. B. in Zelle A1 erfolgt. Soll das so sein?
Oder soll die Routine nur auf Änderungen in einem bestimmten Bereich reagieren?
Noch eine Frage:
Die Routine tut nur etwas, wenn in B35 oder C35 ein X steht. ist das so ok?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: vielleicht so?
14.06.2010 15:35:21
Djalil
Hallo Erich G.,
ich habe Deinen Code getestet. Der funktioniert genau so wie ich gemeint habe. Ich Danke Euch 1000 mal für die Hilfe und für die Bemühungen.
Gruß
Ahmadian
Antworten auf Fragen?
14.06.2010 17:07:24
Erich
Hi Ahmadian,
vielen Dank für deine Rückmeldung. Schön, dass der Code läuft und das tut, was du möchtest!
Aber: Ich hatte dir doch auch zwei, drei Fragen gestellt. Und eigentlich dazu Antworten von dir erwartet.
Möchtest du das noch nachholen?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Antworten an Erich!
15.06.2010 15:35:37
Djalil
Hallo Erich,
Bitte um Entschuldung, dass ich Deine Fragen nicht geanwortet habe.
Die Routine läuft immer los, wenn sich auf dem Blatt ein Wert ändert - auch wenn die Änderung
z. B. in Zelle A1 erfolgt. Soll das so sein? = Antwort: ja soll das so funktionieren!
Die Routine tut nur etwas, wenn in B35 oder C35 ein X steht. ist das so ok? = Antwort: ja, nur wenn x steht!
Ich Danke Dir noch einmal für Deine Bemühung.
VG
Ahmadian
Anzeige
Danke - alles klar! - (owT)
15.06.2010 16:49:39
Erich
etwas kürzer..
14.06.2010 15:01:51
CitizenX
Hallo,
Code kommt ins Modul des Arbeitsblattes
Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer, z As Integer
Dim l As Integer, n As Integer

If Not Intersect(Target, Cells(35, 2)) Is Nothing _
   And LCase(Cells(35, 2)) = "x" Then

   Application.EnableEvents = False
    
    For i = 1 To 3
        n = Choose(i, 1, 9, 15)
        l = Choose(i, 5, 5, 2)
        For z = 4 To 34
           Cells(z, i + 2) = Mid(Cells(z, 2), n, l)
        Next z
    Next i
    
   Application.EnableEvents = True
End If

End Sub

Grüße
Steffen
Anzeige
Bereich angepasst
14.06.2010 15:15:50
CitizenX
Hallo Ahmadian,
der Ausgabebereich war falsch, so sollte es passen:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer, z As Integer
Dim l As Integer, n As Integer

If Not Intersect(Target, Cells(35, 2)) Is Nothing _
   And LCase(Cells(35, 2)) = "x" Then

   Application.EnableEvents = False
    
    For i = 1 To 3
        n = Choose(i, 1, 9, 15)
        l = Choose(i, 5, 5, 2)
        For z = 4 To 34
           Cells(z + 6, i + 2) = Mid(Cells(z, 2), n, l)
        Next z
    Next i
    
   Application.EnableEvents = True
End If

End Sub

Grüße
Steffen
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige