VBA Zähler schreibt in falsches Feld

[proximate]

Hallo miteinander!
Neues Jahr - neue Probleme... Das Ding hat Super funktioniert - doch nun ist Januar und da geht so einiges schief.
Folgendes Problem:
Ich habe ein Statistiktool in Excel gebastelt, Der Zähler hat funktioniert - habe nun die Scripts / Tabellen für 2016 eingerichtet. Leider passiert folgendes. Wenn man heute 04.01.2016 auf einen Button klickt so wird das ganze:

• In der korrekten Wochenspalte +1 gezählt
• jedoch im falschen Monat (Oktober) +1 gezählt

Themenbereiche sind in der vertikalen angeordnet
die Monate resp. KW sind jeweils in Ganzzahlen in der horizontalen auf einem Sheet.

Der Code lautet:

Public Sub MeineSub()

Set FindKW = Tabelle2.Range("B2:BA2").Find(WorksheetFunction.WeekNum(Now(), 2))
'Finde die aktuelle Woche --> OK, da KW1 schon durch ist
Set FindProd = Tabelle2.Range("A4:A21").Find("MeinProdukt")
'Finde den Themenbereich --> OK
If Not FindKW Is Nothing Then
If Not FindProd Is Nothing Then
x = FindProd.Row
y = FindKW.Column

Tabelle2.Cells(x, y).Value = Tabelle2.Cells(x, y).Value + 1

End If
End If

Set FindMonth = Tabelle3.Range("B2:M2").Find(Month(Now()))
'Finde den aktuellen Monat --> Hier ist der Fehler
Set FindProd = Tabelle3.Range("A3:A20").Find("MeinProdukt")
'Finde den Themenbereich
If Not FindMonth Is Nothing Then
If Not FindProd Is Nothing Then
x = FindProd.Row
y = FindMonth.Column

Tabelle3.Cells(x, y).Value = Tabelle3.Cells(x, y).Value + 1
'Monthly Stats sind in Tabelle 3
End If
End If

Range("F5").Value = Range("F5").Value + 1
'Lokaler Zähler auf dem Sheet mit den Buttons
End Sub

Das Problem ist scheinbar das jeder Monat und jede KW mit einer 1 darin das Problem macht, insofern habe ich das PRoblem über das Ganze Jahr hinweg jeweils in KW 1 resp. im Monat 1.
Leider funktioniert explizites Angeben der KW resp. Month nicht wie normal mit "Quotes".

Kann mir da jmd. weiterhelfen?
Wäre ja lachhaft wenn man das Problem mit dem Januar nicht umschippern könnte

 

[michal_k]

Hallo,

Dein Problem ist wahrscheinlich, dass die Woche ab dem 4.1 nicht KW 2 ist. Dies ist leider nicht richtig, denn heute hat KW1 begonnen. siehe

Viele Grüße

MK

 

[Bertram_Heinrichs]

Tabelle2.Range("B2:BA2").Find(WorksheetFunction.WeekNum(Now(), 2))

Set FindMonth = Tabelle3.Range("B2:M2").Find(Month(Now()))

Fehlt da ein Parameter?

 

[proximate]

@michal_k : hmm KW ist funny - also sogar noch ein Problem... XD
@Bertram_Heinrichs : Die oben beschriebenen Formeln haben seit Juli 2015 täglich ohne Probleme funktioniert... Details findest du hier: https://www.psd-tutorials.de/forum/threads/zaehlerbutton-soll-je-nach-kw-in-feld-schreiben.169880/
Also insofern stimmen die Formeln schon nuuuur wird momentan alles als korrekt genommen was eine 1 in der anzahl hat, sprich im Januar haben wir:
Januar
Oktober
November
Dezember
Selbes bei KW:
1,10,11,12,13,14,15,16,17,18,19,21,31,41,51

Ich müsste entweder nach Monatsangabe mit JAN;FEB;MAR;... etc. suchen und dann mein Sheet dementsprechend umbauen (was das KW Problem nicht löst) - oder ich finde einen Weg im Code EXPLIZIT nach der KW 1 oder Month 1 zu suchen und auch nur diesen zu identifizieren...

Bin aber Ratlos was die umsetzung betrifft...

 

[Haui76]

Hallo Proximate,

Der Find() Befehl muss nur mit dem Parameter "lookat:=xlWhole" erweitert werden.
Dieser Parameter legt fest wie gesucht werden soll. Mögliche Werte sind xlWhole und xlPart
xlWhole: Ganzes Feld / Value
xlPart: Teil des Feldes / Values

Zur Komplettierung hier der ganze Syntax des Find():
expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

Bei deinem Code für den Monat wäre das also dann

Set FindMonth = Tabelle3.Range("B2:M2").Find(Month(Now()),lookat:=xlWhole)

Achtung: Die Parameter lookin, lookat und SerachOrder des Find() Befehls werden gespeichert und für jeden weiteren Find() Befehl des Scripts verwendet. Werden diese Parameter gesetzt sollten sie bei jedem Aufruf von Find() neu gesetzt werden.

 

[proximate]

Tolle Sache Danke @Haui76 !
Verstehe ich das Richtig das ich demnach bei jedem Find in jedem SUB das lookat hinzufügen muss?
Edit: ok habs gerade gecheckt, habe die Anpassung bei einer Routine gemacht und alle auch in anderen Subs machen nun den Find auf dieselbe weise - hab dann jedoch mit ctrl+F die anpassungen auf alle scripts gemacht (sicher ist sicher)

Ich stehe noch am Anfang was VB anbelangt und arbeite nicht überall mit variablen demzufolge habe ich für 120 Buttons 120 Subs geschrieben (wie oben beschrieben). Kann mir vorstellen das dies nicht so schön war aber QuickandDirty für unsere Bedürfnisse.

Vielen Dank für deine Hilfe!

 

[Haui76]

Da du für jeden Button ein eigenes Sub geschrieben hast musst du leider auch jedes Find() bearbeiten.

Für die Zukunft würde ich alles was gleich ist in einen eigenes Sub im "General"-Bereich der Tabelle oder des "Workbooks" schreiben und dieses dann mit Argumenten aufrufen. (Stichwort: Vererbung)

Beispiel:
General Tabelle

Public sub FindButton(arg1)

Set FindKW = Tabelle2.Range("B2:BA2").Find(WorksheetFunction.WeekNum(Now(), 2),lookat:=xlWhole)
Set FindProd = Tabelle2.Range("A4:A21").Find(arg1)
If Not FindKW Is Nothing Then
If Not FindProd Is Nothing Then
x = FindProd.Row
y = FindKW.Column

Tabelle2.Cells(x, y).Value = Tabelle2.Cells(x, y).Value + 1

End If
End If
...
end sub​

Button1

Public Sub MeinSub()
FindButton("MeinProdukt1")
end sub​

Nicht auf Lauffähigkeit geprüft.

 

[proximate]

Okey - ja ich muss mich ohnehin dieses Jahr früher für die Lösung im kommenden Jahr auseinandersetzen. WEnn wir weiter mit Excel arbeiten werde ich deinen Rat mit Sicherheit beherzigen .

Betreffend der Anpassungen: war nicht so wild dank Suchen & ersetzen Funktion über einen Partiellen Bereich

Abschliessend nochmals vielen Dank!
Ich hoffe deine / eure Hilfe kann auch noch weiteren Usern helfen.