zählt eben nicht mit den Fingern, sondern benutzt den Kopf (von Excel)
dieser Code ersetzt deinen Code, die Kommentare kannst du ja später löschen
und Alternativen sind gekennzeichnet
Zeitproblem - das Kommando Format liefert eine Zeichenkette, wozu also nochmals konvertieren,
prüfe lieber deine Excel - (Länder) u.a. Voreinstellungen
Zum Rest vom Fest gibt es auch Handbücher
und Tschüss
Option Explicit
'Button ruft diese Prozedur
Private Sub NewEntry_Click()
'Festlegung der obersten Zeile
Const cOBERSTE As Long = 3 'hier die Zahl 3, sonst ändern
'als Bezug gilt : in der Tabelle Log-Data die Zelle Zeile cOberste Spalte 1
'der Bezug ist : immer durch den Punkt vor der Anweisung im Code gegeben
With Sheets("Log-Data").Cells(cOBERSTE, 1)
'ist die oberste Zeile leer? - prüfe die Zeile der bezogenen Zelle
If Application.CountA(.EntireRow) = 0 Then
'ist leer, dann ein erster Eintrag
'die bezogene Zelle von Spalte 1 bis Spalte 17 erweitern und
'mit dem Ergebnis(sen) der Funktion Eingabe füllen
'die Funktion Eingabe dabei mit der 1 versorgen
.Resize(1, 17).Value = Eingaben(1)
Else
'ist NICHT leer, dann ein erst die Zeile der bezogenen Zelle nach unten schieben
.EntireRow.Insert shift:=xlDown
'sind die Zeilen über der bezogenen Zelle leer, dann ginge auch der nächste Befehl
'(auskommentiert)
'.CurrentRegion.Cut .Offset(1)
'
'JETZT muss der Bezug neu verknüpft werden, der alte ist ja gewandert
With Sheets("Log-Data").Cells(cOBERSTE, 1)
'und wieder
'die bezogene Zelle von Spalte 1 bis Spalte 17 erweitern und
'mit dem Ergebnis(sen) der Funktion Eingabe füllen
'die Funktion Eingabe dabei mit dem Wert der darunterliegeneden Zelle versorgen (alter Bezug)
.Resize(1, 17).Value = Eingaben(.Offset(1).Value + 1)
End With
End If
End With
End Sub
Private Function Eingaben(Zahl) As Variant
'erfüllt die Funktion der Datensammlung und Benutzereingaben
'erhält für den ersten Wert "Zahl" übergeben
'ein Datenfeld genau so hoch und breit wie der Zellbereich
'eine Zeile und 17 Spalten
Dim Arr(1 To 1, 1 To 17) As Variant
'die Werte sofort direkt versorgen oder abfragen
Arr(1, 1) = Zahl
Arr(1, 2) = Format(Now, "dd.mm.yy")
Arr(1, 3) = Format(Now, "hh:nn:ss")
Arr(1, 4) = Worksheets("Log-Entry").Cells(7, 4)
Arr(1, 5) = Worksheets("Log-Entry").Cells(8, 4)
Arr(1, 6) = Worksheets("Log-Entry").Cells(6, 4)
Arr(1, 7) = InputBox("Used Frequency in MHz like 145000,00")
Arr(1, 8) = InputBox("Used Frequency Band in m like 2m")
Arr(1, 9) = InputBox("Used Mode like FM, DMR...")
'hier für die spätere Spalte 10 gleich voreinstellen
Arr(1, 10) = "none"
'und nur wenn
If InStr("FMDMR", UCase(Arr(1, 9))) > 0 Then _
Arr(1, 10) = InputBox("Eventually used Relais in FM or DMR...")
'der Unterstrich _ verkettet, daher kein End If
'
Arr(1, 11) = InputBox("Received Signal Level")
Arr(1, 12) = InputBox("Transmitted Signal Level")
Arr(1, 13) = InputBox("Callsign of OM/YL")
'ditto
Arr(1, 14) = "none"
'achte auf die Groß-/Kleinschreibung
If UCase(Arr(1, 9)) = "DMR" Then _
Arr(1, 14) = InputBox("DMR-ID of OM/YL")
'ggf.
If InStr("FMDMR", UCase(Arr(1, 9))) > 0 Then Arr(1, 9) = UCase(Arr(1, 9))
'
Arr(1, 15) = InputBox("Country of OM/YL")
Arr(1, 16) = InputBox("Quality of QSO")
Arr(1, 17) = InputBox("Eventually Notes to the QSO")
'das gefüllte Datenfeld an die Funktion, die übergibt an die einzelnen Zellen
Eingaben = Arr
End Function
|