title image


Smiley Re: Mehrere nebeinander liegende Spalteneinträge mit einer Zahl vergleichen
Hallo Friedel,



etwas mehr Komfort, etwas mehr Sicherheit, etwas mehr Erläuterung im Makro:



Public Sub Auftragsabwicklung()



Dim lZeile As Long ' For/Next Zeilenindex

Dim iSpalte As Integer ' For/Next Spaltenindex

Dim bGefund As Boolean ' Schalter gefunden Ja/Nein - False/True

Dim iZahl As Integer ' Anzahl KW je Auftrag

Dim iIndex As Integer ' For/Next Spaltenindex

Dim iKW_V As Integer ' KalenderWoche Von

Dim iKW_B As Integer ' KalenderWoche Bis



For lZeile = 4 To Range("Q65536").End(xlUp).Row ' ab Zeile 4 alle Zeilen

If Range("Q" & lZeile).Value = Year(Date) Then ' aktuelles Jahr ?

bGefund = False ' Schalter 'gefunden' auf NEIN

If Range("O" & lZeile).Value < 11 Then ' von-KW < 11 ?

iKW_V = 11 ' dann auf 11 setzten

Else ' sonst

iKW_V = CInt(Range("O" & lZeile).Value) ' von-KW übernehmen

End If

If Range("P" & lZeile).Value < Range("O" & lZeile).Value Then

iKW_B = 52

Else

iKW_B = CInt(Range("P" & lZeile).Value)

End If

For iSpalte = 21 To 62 ' Beginn KW im Bereich Spalte U - BJ suchen

If iKW_V = CInt(Cells(3, iSpalte).Value) Then

bGefund = True ' Schalter 'gefunden' auf JA

Exit For ' For/Next verlassen

End If

Next iSpalte

If bGefund = True Then ' Schalter 'gefunden' auf JA ?

iZahl = iKW_B - iKW_V + 1 ' Anzahl KW ermitteln

iIndex = iSpalte ' Spalte speichern

For iSpalte = iIndex To (iIndex + iZahl - 1) ' ab Anfangs - Ende KW

If iSpalte < 63 Then ' Spalte < 'BK'

'Cells(lZeile, iSpalte).Value = "X" ' ein X setzen

Cells(lZeile, iSpalte).Value = iZahl ' Anzahl KW einfügen

End If

Next iSpalte

End If

End If

Next lZeile



Cells.EntireColumn.AutoFit



End Sub





Gruß Peter

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: