Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1600to1604
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

OnKey + dynamisch einfügen

OnKey + dynamisch einfügen
15.01.2018 10:26:17
Thomas
Guten Morgen,
aktuell versuche ich mich an der Funktion Application.OnKey, allerdings würde ich das gerne dynamischer gestalten.
Die Funktion nutze ich in einem Kalender.
Nun wäre es schön, wenn der Monat rum ist er in eine neue Zeile springt, bzw wenn ein Feiertag ist soll er in diesen Tag überspringen.
Ich hoffe das Beispiel erklärt es besser...
https://www.herber.de/bbs/user/118972.xlsm
Danke Thomas

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

Betreff
Datum
Anwender
Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 12:49:32
yummi
Hallo Thomas,
mal exemplarisch eine Möglichkeit für 1 schreiben

Sub WriteOne()
Dim i As Integer
Dim ioffset As Integer
For i = 0 To 4
If ThisWorkbook.Sheets(1).Cells(ActiveCell.Row, ActiveCell.Column + ioffset).Offset(-4, 0). _
Value  "" Then
With Cells(ActiveCell.Row, ActiveCell.Column + ioffset)
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
ioffset = ioffset + 1
Else
Cells(ActiveCell.Row, ActiveCell.Column + ioffset).Offset(11, -1 * (ActiveCell.Column +  _
ioffset - 2)).Select
With ActiveCell
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
ioffset = 1
End If
Next i
End Sub
Gruß
yummi
Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 13:05:32
Thomas
Hallo yummi,
vielen dank für dein Beispiel , so habe ich mir das in etwa vorgestellt, allerdings ist mir aufgefallen, das deine Möglichkeit nur bei Arbeiter 1 und 2 funktioniert, leider nicht mehr bei Arbeiter 3,4,5 usw...
Gruß Thomas
AW: OnKey + dynamisch einfügen
15.01.2018 13:37:53
yummi
Hallo Thomas,
sry ein offset falsch berechnet.

Sub WriteOne()
Dim i As Integer
Dim j As Integer
Dim ioffset As Integer
Dim irowdate As Integer
irowdate = 2
If ActiveCell.Row > 13 Then
irowdate = 13
End If
If ActiveCell.Row > 13 Then
irowdate = 13
End If
If ActiveCell.Row > 24 Then
irowdate = 24
End If
For i = 0 To 4
If ThisWorkbook.Sheets(1).Cells(irowdate, ActiveCell.Column + ioffset).Value  "" Then
With Cells(ActiveCell.Row, ActiveCell.Column + ioffset)
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
ioffset = ioffset + 1
Else
Cells(ActiveCell.Row, ActiveCell.Column + ioffset).Offset(11, -1 * (ActiveCell.Column +  _
_
ioffset - 2)).Select
With ActiveCell
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
ioffset = 1
End If
Next i
End Sub

Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 13:48:29
Thomas
Vielen Dank, das funktioniert jetzt echt super.
Hättest du noch eine Idee für die Feiertag Problematik?
z.B. in der KW 1, das er Montag auslässt, obwohl Montag eben die Aktive Zelle wäre,
oder KW13, das er hier den Freitag weglässt?
Danke Thomas
AW: OnKey + dynamisch einfügen
15.01.2018 14:07:45
yummi
Hallo Thomas,
du hast die Feiertagsnamen ja in der jeeweils 3. zeile eingetragen. könnte man als Tabelle auf extra sheet hinterlegen (gibt ja genug Beispiele im netz) und dann z.b mit hilfe eienr Formel automatisch befüllen.
Dann könntest du 

If ThisWorkbook.Sheets(1).Cells(irowdate, ActiveCell.Column + ioffset).Value  "" then
if ThisWorkbook.Sheets(1).Cells(irowdate+2, ActiveCell.Column + ioffset).Value = "" Then
ioffset = ioffset +1
end if
das so abfragen
Gruß
yummi
Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 14:59:52
Thomas
Hallo yummi,
ja die Zeile lass ich im Hintergrund automatisch errechnen und befüllen.
aber ich wusste nicht wie ich überprüfe, bzw. unterbinde das er mir hier nichts einträgt.
Aktuell sieht mein Code so aus:
Sub WriteOne()
Dim i As Integer
Dim j As Integer
Dim ioffset As Integer
Dim irowdate As Integer
irowdate = 2
Select Case ActiveCell.Row
Case Is > 387: irowdate = 387   'Dez
Case Is > 352: irowdate = 352   'Nov
Case Is > 317: irowdate = 317   'Okt
Case Is > 282: irowdate = 282   'Sep
Case Is > 247: irowdate = 247   'Aug
Case Is > 212: irowdate = 212   'Juli
Case Is > 177: irowdate = 177   'Juni
Case Is > 142: irowdate = 142   'Mai
Case Is > 107: irowdate = 107   'April
Case Is > 72: irowdate = 72     'März
Case Is > 37: irowdate = 37     'Feb
End Select
For i = 0 To 4
If Cells(irowdate, ActiveCell.Column + ioffset).Value  "" Then
If Cells(irowdate + 2, ActiveCell.Column + ioffset).Value = "" Then
With Cells(ActiveCell.Row, ActiveCell.Column + ioffset)
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
End If
ioffset = ioffset + 1
Else
Cells(ActiveCell.Row, ActiveCell.Column + ioffset).Offset(35, -1 * (ActiveCell.Column +  _
ioffset - 2)).Select
If Cells(irowdate + 2, ActiveCell.Column + ioffset).Value = "" Then
With ActiveCell
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
End If
ioffset = 1
End If
Next i
End Sub
Allerdings kommt er ins schleudern , wenn wie z.b. am 01.05 ein Feiertag ist...
Kann man den Ersten Teil vom Code (Select Case) ausklammern , sodass ich es für jeden Code zur Verfügung stellen kann?
Danke Thomas
Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 15:49:39
yummi
Hallo Thomas,
wenn ich dich richtig verstehe, dann so:

function BerechneRow(ByVal irow) as long
dim irowdate as long
Select Case irow
Case Is > 387: irowdate = 387   'Dez
Case Is > 352: irowdate = 352   'Nov
Case Is > 317: irowdate = 317   'Okt
Case Is > 282: irowdate = 282   'Sep
Case Is > 247: irowdate = 247   'Aug
Case Is > 212: irowdate = 212   'Juli
Case Is > 177: irowdate = 177   'Juni
Case Is > 142: irowdate = 142   'Mai
Case Is > 107: irowdate = 107   'April
Case Is > 72: irowdate = 72     'März
Case Is > 37: irowdate = 37     'Feb
Case Is > 2: irowdate = 2    'Jan
End Select
BerechneRow = irowdate
end function

Dann kannst Du in deiner Funktion bei Bedarf das so aufrufen 

Sub WriteOne()
Dim i As Integer
Dim j As Integer
Dim ioffset As Integer
Dim irowdate As Integer
irowdate = BerechneRow(ActiveCell.Row)
Gruß
yummi
Anzeige
AW: OnKey + dynamisch einfügen
15.01.2018 16:18:53
Thomas
Kannst du noch einen Fehler erkennen , warum er am 01.05.2018 etwas einträgt, dann ins schleudern kommt und dann am 02.05.2018 nichts einträgt? obwohl es genau anders rum sein müsste?
AW: OnKey + dynamisch einfügen
15.01.2018 16:56:53
yummi
Hallo Thomas,
die Zeilen, die Du da ausrechnest, haben ichts mit deiner ursprünglichen geposteten Datei zu tun. Ich hoffe es passt so. Bei Monatsübergang muss die Datumsreihe neu bestimmt werden, das hat gefehlt. Zusätzlich muss die Schleifenvariable manipuliert werden, da ein Tag übersprungen wird. 

Sub WriteOne()
Dim i As Integer
Dim j As Integer
Dim ioffset As Integer
Dim irowdate As Integer
irowdate = BerechneRow(ActiveCell.Row)
For i = 0 To 4
If Cells(irowdate, ActiveCell.Column + ioffset).Value  "" Then
If Cells(irowdate + 2, ActiveCell.Column + ioffset).Value = "" Then
With Cells(ActiveCell.Row, ActiveCell.Column + ioffset)
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
End If
ioffset = ioffset + 1
Else
Cells(ActiveCell.Row, ActiveCell.Column + ioffset).Offset(9, -1 * (ActiveCell.Column + _
_
ioffset - 2)).Select
i = i + 1  'macht man eigentlich nicht, aber weil ein Tag übersprungenwurde und  _
nciht der wochentag abefragt wird
irowdate = BerechneRow(ActiveCell.Row)
ioffset = 0
If Cells(irowdate + 2, ActiveCell.Column + ioffset).Value = "" Then
With ActiveCell
.Value = "1"
.Font.ColorIndex = 32
.Font.FontStyle = "Fett"
End With
End If
ioffset = ioffset + 1
End If
Next i
End Sub
Gruß
yummi
Anzeige
AW: OnKey + dynamisch einfügen
16.01.2018 14:31:46
Thomas
Vielen Herzlichen Dank. Jetzt ist es genau so wie ich es mir gewünscht habe :-)

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige