Thema Datum  Von Nutzer Rating
Antwort
26.03.2016 18:35:12 thiro
NotSolved
26.03.2016 19:02:59 trinchen
NotSolved
26.03.2016 19:45:16 Gast70117
NotSolved
26.03.2016 22:17:28 Gast60054
NotSolved
26.03.2016 22:19:03 Gast12754
NotSolved
27.03.2016 11:29:33 Gast70117
NotSolved
27.03.2016 14:37:07 thiro
NotSolved
27.03.2016 18:06:50 Gast84530
NotSolved
Rot Das ist VBA
27.03.2016 18:24:34 Gast70117
Solved
27.03.2016 18:36:49 thiro
NotSolved

Ansicht des Beitrags:
Von:
Gast70117
Datum:
27.03.2016 18:24:34
Views:
815
Rating: Antwort:
 Nein
Thema:
Das ist VBA

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
26.03.2016 18:35:12 thiro
NotSolved
26.03.2016 19:02:59 trinchen
NotSolved
26.03.2016 19:45:16 Gast70117
NotSolved
26.03.2016 22:17:28 Gast60054
NotSolved
26.03.2016 22:19:03 Gast12754
NotSolved
27.03.2016 11:29:33 Gast70117
NotSolved
27.03.2016 14:37:07 thiro
NotSolved
27.03.2016 18:06:50 Gast84530
NotSolved
Rot Das ist VBA
27.03.2016 18:24:34 Gast70117
Solved
27.03.2016 18:36:49 thiro
NotSolved