Vortalos

VBA CheatSheet?

Jun 28th, 2021
1,343
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. UFORM
  2. ------------------------------------------------------------------------------------------------------------------------------------------
  3. Option Explicit
  4.  
  5. Public filename As String
  6.  
  7. Private Sub Auswahl_Click()
  8.    
  9.   'Hinweis: Application.GetOpenFilename()
  10.  ' könnte vielleicht hier helfen
  11.  
  12.   filename = Application.GetOpenFilename()
  13.  
  14.   TextBox1.Text = filename
  15.  
  16. End Sub
  17.  
  18.  
  19. Private Sub Dateiname_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  20.  
  21.     MsgBox ("This is Dateiname!")
  22.  
  23. End Sub
  24.  
  25. Private Sub Lesen_Click()
  26. 'Ausführung
  27. 'Fehlerausgang definieren
  28. On Error GoTo Fehlerausgang
  29.  
  30. '0. Schritt: Variablen festlegen
  31.  
  32.  
  33.  
  34.  
  35. '1. Schritt: Prüfung der Eingaben im Feld "Dateiname"
  36.  
  37.  
  38.  
  39.  
  40. '2. Datei lesen, umarbeiten
  41.  
  42.  
  43.  
  44.  
  45. Exit Sub
  46. 'Fehlerausgang
  47. Fehlerausgang:
  48. MsgBox "Fehlerhafte Eingabe oder sonst was"
  49.  
  50. End Sub
  51.  
  52. Private Sub Ende_Click()
  53.     'Dialog schließen
  54.    Me.Hide
  55. End Sub
  56.  
  57.  
  58. Private Sub CommandButton1_Click()
  59.     'Me.Hide
  60.    Unload Me
  61. End Sub
  62.  
  63. Private Sub CommandButton2_Click()
  64.     If filename = "" Then
  65.         MsgBox "Ungültige Eingabe"
  66.     Else
  67.         Loggerdateiöffnen (filename)
  68.         stundenwerte
  69.         Unload Me
  70.     End If
  71. End Sub
  72.  
  73. Private Sub Label4_Click()
  74.  
  75. End Sub
  76.  
  77. Private Sub TextBox1_Change()
  78.     filename = TextBox1.Text
  79. End Sub
  80.  
  81. FUNKTION
  82. ------------------------------------------------------------------------------------------------------------------------------------------
  83. Option Explicit
  84. Dim VarDatei As Variant 'Kurzname der Workbookdatei
  85.  
  86.  
  87.  
  88. Sub Loggerdateiöffnen(DName As String)
  89. 'Öffnet die Loggerdate als Excel-Workbook und kopiert um
  90. Dim PathElements() As String
  91. Dim filename As String
  92. Dim FileNameElements() As String
  93. Dim File As String
  94. Dim CurrentWorkbook, LoggerWorkbook As String
  95. Dim LastUsedRow As String
  96.  
  97. CurrentWorkbook = ActiveWorkbook.name
  98.  
  99. Sheets.Add Before:=ActiveWorkbook.Sheets(1)
  100. ActiveWorkbook.Sheets(1).name = "Strahlung"
  101.  
  102. Workbooks.Open (DName)
  103. filename = ActiveWorkbook.name
  104.  
  105. Workbooks(filename).Worksheets(1).Range("A:A").Copy Workbooks(CurrentWorkbook).Worksheets(1).Range("A:A")
  106. Workbooks(filename).Worksheets(1).Range("E:E").Copy Workbooks(CurrentWorkbook).Worksheets(1).Range("B:B")
  107.  
  108. Workbooks(filename).Close SaveChanges:=False
  109.  
  110. Workbooks(CurrentWorkbook).Activate
  111.  
  112. 'Formatierung mit entsprechenden Einheiten
  113. ActiveWorkbook.Worksheets("Strahlung").Range("B:B").NumberFormat = "# ##0" & Space(1) & Chr$(34) & "W/m²" & Chr$(34)
  114.  
  115.  
  116. 'Sonnenschein schreiben
  117. Range("c1") = "Sonnenschein"
  118. Dim Cell As Range
  119.  
  120. For Each Cell In ActiveWorkbook.Worksheets(1).Range("B2:B" & ActiveWorkbook.Worksheets(1).Range("B1").End(xlDown).Row)
  121.     If Cell.Value >= 120 Then
  122.         Cell.Offset(0, 1).Value = True
  123.     Else
  124.         Cell.Offset(0, 1).Value = False
  125.     End If
  126. Next Cell
  127.  
  128. 'neues Blatt Stundenwerte anlegen, Überschriften schreiben, dann Werte eintragen
  129.  
  130. ' dann Schleife wie oben, aber Ausgabe in eigenem range
  131.  
  132.  
  133. End Sub
  134.  
  135. Sub stundenwerte()
  136. 'Erzeugt aus den 10-min Werten auf dem Blatt Strahlung die
  137. 'Stundenwerte auf dem Blatt Stundenwerte
  138.  
  139. 'Deklarationen
  140. Dim Zelle, DateRange As Range
  141. Dim VarDatei As String
  142. Dim StundenCounter, AktuelleStunde, AktuelleZeile As Integer
  143. Dim SonnenZähler, StrahlungZähler As Variant
  144.  
  145.  
  146. 'Richtige DAtei aktivieren, Blatt anlegen, Überschriften schreiben
  147. 'Workbooks(VarDatei).Activate
  148.  
  149. Sheets.Add After:=ActiveWorkbook.Sheets(1)
  150. ActiveWorkbook.Sheets(2).name = "Stundenwerte"
  151.    
  152. Range("A1").Value = "Datum/Stunden"
  153. Range("B1").Value = "Stunde"
  154. Range("C1").Value = "Mittlere Einstrahlung"
  155. Range("D1").Value = "Sonnenscheindauer"
  156. ActiveWorkbook.Worksheets("Stundenwerte").Range("A:A").NumberFormat = "dd/mm/yyyy hh"
  157. ActiveWorkbook.Worksheets("Stundenwerte").Range("C:C").NumberFormat = "####0.0"
  158. ActiveWorkbook.Worksheets("Stundenwerte").Range("D:D").NumberFormat = "####0.0"
  159.  
  160. ActiveWorkbook.Worksheets("Stundenwerte").Columns("A").ColumnWidth = 15
  161. ActiveWorkbook.Worksheets("Stundenwerte").Columns("C").ColumnWidth = 20
  162. ActiveWorkbook.Worksheets("Stundenwerte").Columns("D").ColumnWidth = 18
  163.  
  164. 'Ranges festlegen
  165. Set DateRange = ActiveWorkbook.Worksheets("Strahlung").Range("A2:A" & CStr(ActiveWorkbook.Worksheets(1).Range("A1").End(xlDown).Row))
  166.  
  167.  
  168. 'Umrechnen und schreiben
  169. 'Lesebereich durchlaufen und jeweils nach 6 Zeilen die summierten Werte rausschreiben
  170. 'Vielleich in etwa so: For Each Zelle In LeseRange
  171.  
  172. StundenCounter = 1
  173. AktuelleZeile = 2
  174. SonnenZähler = 0
  175. For Each Zelle In DateRange
  176.     If Zelle.Offset(0, 2).Value = True Then
  177.         SonnenZähler = SonnenZähler + 1
  178.     End If
  179.     StrahlungZähler = StrahlungZähler + Zelle.Offset(0, 1).Value
  180.    
  181.     StundenCounter = StundenCounter + 1
  182.     If StundenCounter > 6 Then
  183.         'Zelle schreiben
  184.        ActiveWorkbook.Worksheets(2).Range("A" & CStr(AktuelleZeile)).Value = Zelle.Value
  185.         ActiveWorkbook.Worksheets(2).Range("B" & CStr(AktuelleZeile)).Value = DateTime.Hour(Zelle)
  186.         ActiveWorkbook.Worksheets(2).Range("C" & CStr(AktuelleZeile)).Value = StrahlungZähler / 6
  187.         ActiveWorkbook.Worksheets(2).Range("D" & CStr(AktuelleZeile)).Value = SonnenZähler / 6
  188.        
  189.         AktuelleZeile = AktuelleZeile + 1
  190.         StundenCounter = 1
  191.         StrahlungZähler = 0
  192.         SonnenZähler = 0
  193.     End If
  194.    
  195. Next Zelle
  196.    
  197.    
  198.    
  199.  
  200.    
  201. ' Next Zelle
  202.  
  203. End Sub
  204.  
  205. Sub Form_Wm2(FBereich As Range)
  206.  
  207.  
  208.  
  209. End Sub
  210.  
  211.  
  212.  
  213. HILFSFUNKTIONEN
  214. ------------------------------------------------------------------------------------------------------------------------------------------
  215. Option Explicit
  216.  
  217. Function kWhm2__kJcm2(Watt)
  218. 'Konvertiert Größen Wh/m² nach kJ/cm²
  219. 'Formel: 1 kJ/cm² = 2,78 kWh/m².
  220.  
  221. On Error GoTo Problem
  222.  
  223. If IsNumeric(Watt) Then
  224.  
  225.     kWhm2__kJcm2 = (Watt / 2.78)
  226.    
  227. Else
  228.  
  229.     kWhm2__kJcm2 = "Ungültige Eingabe"
  230.    
  231. End If
  232.  
  233. Exit Function
  234.  
  235. Problem:
  236.     MsgBox "Es gab ein Problem."
  237.  
  238. End Function
  239.  
  240. Function ExistBlatt(name As String) As Boolean
  241.    
  242.     Dim Blatt As Object
  243.     ExistBlatt = False
  244.    
  245.     For Each Blatt In ActiveWorkbook.Sheets
  246.         If Blatt.name = name Then
  247.             ExistBlatt = True
  248.             Exit Function
  249.         End If
  250.     Next Blatt
  251.    
  252. End Function
  253.  
  254.  
  255.  
  256.  
  257. Function ExistDatei(name As String) As Boolean
  258.    
  259.     Dim FileExists As String
  260.     Dim Datei As Object
  261.     ExistDate = True
  262.    
  263.     FileExists = Dir(name)
  264.    
  265.     If FileExists = "" Then
  266.         ExistDatei = False
  267.         Exit Function
  268.     End If
  269.        
  270.     Next Something
  271.  
  272. End Function
  273.  
  274.  
  275. WORKBOOK
  276. ------------------------------------------------------------------------------------------------------------------------------------------
  277. Option Explicit
  278.  
  279. Private Sub Workbook_Open()
  280. 'Benutzerformular anzeigen
  281. Load UForm1
  282. UForm1.Show
  283.  
  284. End Sub
RAW Paste Data