problemen met betaand macro

[mido86]

geachte Lezers,

ik heb het volgende probleem met onderstaand macro!

is er iemand die kann verklaren waarom hij alleen de volgende cellen naar beneden een x zet en niet zoekt over de hele kolom? terwijl hij op op de zelfde waarde moet zoeken in kolom D en dus zou ik achter eentje een kruisje zetten moeten hij overal een kruis zetten

en wat de eventuele oplossing zou kunnen zijn?

bijlage onderaan bericht!


alvast bedankt

mvg,

Mido

Sub Steckscheiben()
With Worksheets("Alle Steckscheiben incl. Stopnr")
ZeileMax = .Cells(65000, 1).End(xlUp).Row
For Z = 2 To ZeileMax
If .Cells(Z, 22) = "x" Then
Steckpos = .Cells(Z, 4)
.Cells(Z, 4).Interior.ColorIndex = 4
For S = Z To ZeileMax
If .Cells(S, 4) = Steckpos Then
.Cells(S, 4).Interior.ColorIndex = 4
.Cells(S, 22) = "x"
End If
Next S
End If
Next Z




End With

End Sub

Bekijk bijlage HelpForum.xlsm

 

[MarcelBeug]

Welkom op het forum.
Als je code plaatst is het handig om CODE-tags te gebruiken.
Deze regel is het euvel:
For S = Z To ZeileMax
Dit moet zijn:
For S = 2 To ZeileMax

Edit (voor de meelezers): kolom 22 in de vermelde code in post #1, is in het voorbeeldbestand kolom 5.

De code wordt dan, met beter leesbare layout en CODE-tags:

Sub Steckscheiben()
    With Worksheets("Alle Steckscheiben incl. Stopnr")
        ZeileMax = .Cells(65000, 1).End(xlUp).Row
        For Z = 2 To ZeileMax
            If .Cells(Z, 5) = "x" Then
                Steckpos = .Cells(Z, 4)
                .Cells(Z, 4).Interior.ColorIndex = 4
                For S = 2 To ZeileMax
                    If .Cells(S, 4) = Steckpos Then
                        .Cells(S, 4).Interior.ColorIndex = 4
                        .Cells(S, 5) = "x"
                    End If
                Next S
            End If
        Next Z
    End With
End Sub

 

[mido86]

super en bedankt voor de snelle reactie en tip!

hallo MarcelBeug

bedankt voor de snelle reactie en tip!!