title image


Smiley Re: Nochmal "Schleife über Spalten"
Hallo liebe Leute,

Jetzt habe ich zu meinem Bild noch einen Teil des Codes den ich verwende hier abgebildet.



Ich bin z.Z dabei mir so etwas wie einen Projektkalender zu erstellen, der die Kalenderwochendaten in einen grafischen Überblick verwandelt:

Ich habe 1 bis 52 Spalten (entspricht den Kalenderwochen (KW) eines Jahres). Eine Spalte "Feld Ad3" (gelb) bildet immer die aktuelle Woche ab. Links davon werden die bereits abgelaufenen 10 KW, rechts davon die noch kommenden 41 KW abgebildet. Die aktuelle KW wird nach dem aktuellen Zeitverlauf Woche für Woche aktualisiert. Die Wochen des Jahres 2007 rücken woche für Woche an das gelbe Feld heran.



Für die grafische Darstellung schreibe ich analog der KW- Daten in die Felder (formatiert auf Wingdings) ein "n" in ein passendes Feld.



Als Projektdaten habe ich links davon das "Eingangsjahr", die "Eingangswoche", das "Erledigungsjahr" und die "Erledigungswoche" als Variablen.



Ich habe mir schon einige Anweisungen zusammengebastelt. Vorwiegend innerhalb einer Schleife mit While ; Wend in der wiederum "For" "Next" über Spalten eingebaut ist.



Für das aktuelle Jahr, sowie für Teile des folgenden Jahres 2007 klappt es schon ganz gut. Wenn ich aber den Übergang von der 52. KW zur 1. KW simuliere funzt es nicht mehr. Es wird mir zu unübersichtlich und glaube auch nicht dass ich da mit Logik weiter komme

Jetzt würde ich gerne Folgendes ausprobieren: Vor dem Hintergrund des sich Woche für Woche veränderndes Kalenderhintergrundes nach links, möchte ich einfach aus den vorliegen Projektdaten die Kalenderwochen zusammen addieren und selbige entsprchend der Menge auf den Kalender schreiben. Z.B. Woche 14 aus 2006 bis Woche 6 in 2007, macht zusammen 44 Wochen, die dann in der 14. Kw beginnen. usw.

Allerdings reichen meine VBA - Kenntnisse nicht mehr so weit, dass ich alle Fälle abdecken kann: Eingang letztes Jahr - Fertig im aktuellen Jahr; Eingang dieses Jahr - Fertig im aktuellen Jahr; Eingang letztes Jahr - Fertig nächstes Jahr; Eingang dieses Jahr - Fertig im nächsten Jahr. Außerhalb der Wochen wird die Anzeige nach links und rechts abgeschnitten. Hat hier jemand eine Idee? Gruß Friedel Dank im Voraus

Sub einfüllen_1()

Dim Jahr As Variant

Dim Woche_links As Double

Dim Eingangsjahr As Double

Dim Eingangswoche As Double

Dim betriebsbereit As Double

Dim anno As Double

Dim Erl_Jahr As Double

Dim zeile As Double

Dim akt_Woche As Double

Dim Differenz_bb_bbk As Integer

Dim Differenz_bb_bbk_alt As Integer

Dim Differenz_bb_bbk_alt_1 As Integer



Jahr = Now

anno = Format(Jahr, "yyyy")

akt_Woche = Format(Jahr, "ww")

Woche_links = Sheets("Vh-Liste").Range("U3")

y = 2

anfang = y

Sheets("Tabelle1").Activate

While Cells(y, 1) ""

Eingangsjahr = Sheets("Tabelle1").Cells(y, 17)

Sheets("Vh-Liste").Cells(y + 2, 14) = Eingangsjahr



Erl_Jahr = Sheets("Tabelle1").Cells(y, 23)

Sheets("Vh-Liste").Cells(y + 2, 17) = Erl_Jahr



betriebsbereit = Sheets("Tabelle1").Cells(y, 26)

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

betriebsbereit = Sheets("Tabelle1").Cells(y, 24)

Sheets("Vh-Liste").Cells(y + 2, 16) = betriebsbereit

If betriebsbereit > "52" Then

Sheets("Vh-Liste").Cells(y + 2, 16) = betriebsbereit

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Eingangswoche = Sheets("Tabelle1").Cells(y, 18)

Sheets("Vh-Liste").Cells(y + 2, 15) = Eingangswoche



If Sheets("Vh-Liste").Cells(y + 2, 14) < anno Then

Sheets("Vh-Liste").Cells(y + 2, 15) = Woche_links

End If

If Sheets("Vh-Liste").Cells(y + 2, 15) < Woche_links Then

Sheets("Vh-Liste").Cells(y + 2, 15) = Woche_links



End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Erl_Jahr = anno Then 'Wenn Eingangsjahr = aktuelles jahr ist

Differenz_bb_bbk = (Sheets("Vh-Liste").Cells(y + 2, 16) - Woche_links)

Else: Differenz_bb_bbk = 51

End If

If Eingangsjahr < anno Then 'Wenn Eingangsjahr kleiner als aktuelles jahr ist

Differenz_bb_bbk_alt = (Sheets("Vh-Liste").Cells(y + 2, 16) - Woche_links)

Else: Differenz_bb_bbk_alt = 51

End If

If Erl_Jahr > anno Then 'Wenn Erledigungsjahr größer als das aktuelle Jahr ist

Differenz_bb_bbk_alt_1 = (Sheets("Vh-Liste").Cells(y + 2, 16) - Woche_links)

Else: Differenz_bb_bbk_alt_1 = 51

End If



Sheets("Vh-Liste").Select

Dim spalte

For spalte = 21 To 21 + Differenz_bb_bbk

'YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY anfang

If Erl_Jahr = anno And Eingangswoche <= Cells(3, spalte).Value Then

Cells(y + 2, spalte) = "n"

End If

'YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY ende

Next



Dim spalte_1

For spalte_1 = 21 To 21 + Differenz_bb_bbk_alt



If Eingangsjahr = Cells(3, spalte_1).Value Then

Cells(y + 2, spalte_1) = "n"

End If



Next



Sheets("Tabelle1").Select



y = y + 1

Wend

End Sub



Hat hier jemand eine Idee? Gruß Friedel

geschrieben von

Anhang
Bild 12819 zu Artikel 592442

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: