Hab mich zwar belesen aber mir sind einige Aspekte dennoch unschlüssig.. Aktuell bin ich soweit.. stimmt das ? / kann mir jemand helfen bei den Kommentaren wo noch Fragezeichen stehen
'************************************************************************************************************
' Namen der Parameter in einen regulären Ausdruck schreiben und darüber den dazugehörigen Wert auslesen *
' ausgelesene Werte über ein Dictionary durchreichen *
' -> Felder werden passend mit Werten gefüllt, wenn gegeben *
'************************************************************************************************************
'Modul, durch welches alle Variablen explizit deklariert werden müssen -> wenn nicht, dann Kompilierungsfehler
Option Explicit
'Public Sub = kann von allen Modulen der Mappe/ Datei aufgerufen werden
Public Sub ExtractParamsFromClipboard()
'Variablendeklaration
Dim rngParams As Excel.Range
Dim strData As String
Dim zeile As Long
'alle Parameter von Spalte A markieren
'letzte beschriebene Zeile ermitteln
zeile = Range("A65536").End(xlUp).Row
'A1 bis letzter beschriebene Zeile in Spalte A markieren
Range("A1:A" & zeile).Select
'Anzahl der Parameter durch Markierung in rngParams schreiben
Set rngParams = Selection
'Rückgabewert von Funktion "GetClipboardTextData" in strData schreiben
strData = GetClipboardTextData()
'Prüfen, ob Daten in Zwischenlage sind -> wenn nein, dann Fehlermeldung & Sub beenden
If strData = "" Then
Call MsgBox("Keine Daten in der Zwischenablage gefunden.", vbExclamation)
Exit Sub
End If
'Prüfen, ob mind. 2 Zellen/ Zeilen und maximal 1 Spalte markiert wurde -> wenn nein, dann Fehlermeldung & Sub beenden
If rngParams.Cells.Count = 1 Or rngParams.Columns.Count > 1 Then
Call MsgBox("Aktuelle Auswahl verletzt Kriterien:" _
& vbNewLine & "Max-Spalten: 1, Min-Zellen: 2", _
vbExclamation)
Exit Sub
End If
'Variablendeklaration
Dim vntParam As Variant
Dim dicParams As Object
'????
Set dicParams = CreateObject("Scripting.Dictionary")
For Each vntParam In rngParams.Cells
dicParams(vntParam) = Empty
Next
'Funktionsaufruf ExtractParams
Call ExtractParams(strData, dicParams)
'????
For Each vntParam In rngParams.Cells
vntParam.Offset(0, 1).Value = dicParams(vntParam.Value)
Next
'Message-Box sagt an, wenn Makro die Arbeit beendet hat
Call MsgBox("Daten übermittelt.", vbInformation)
End Sub
'Private Sub ist nur im Projekt verfügbar, sprich nur auf dem Blatt
Private Sub ExtractParams(Expr As String, ByRef ParamDictionary As Object)
'Variablendeklaration
Dim objMatch As Object
Dim strPattern As String
'Regularen Ausdruck = Textuntersuchung
'Objekt mit Typ RegExp anlegen
With CreateObject("VBScript.RegExp")
'ersten gefundenen Ausdruck wiedergeben, bei mehrfach matchen
.Global = True
'Unterscheidung zwischen Groß- & Kleinschreibung
.IgnoreCase = True
'Zeilenumbrüche im Suchstring = jeder Zeilenumbruch als einzelne Zeile betrachten
.MultiLine = True
'Join = Eindimensionaler Array "ParamDictionary.Keys() zu einem String zusammenfügen
'ParamDictionary.Key() = gibt ein array aller "Keys" (Schlüssel in einem Dictionary-Objekt zurück
strPattern = Join(ParamDictionary.Keys(), vbNullChar)
'Vergleichsmuster setzen
.Pattern = "([-[\]{}()*+?.,\\^$|#\s])"
'Ersetzungen im Suchstring
strPattern = .Replace(strPattern, "\$1")
strPattern = Replace$(strPattern, vbNullChar, "|")
strPattern = "(" & strPattern & ")\s+([^\r\n]+)"
'????
.Pattern = strPattern
'????
For Each objMatch In .Execute(Expr)
ParamDictionary(objMatch.Submatches(0)) = objMatch.Submatches(1)
Next
End With
End Sub
'Funktonsdeklaration mit Rückgabewert als String
Public Function GetClipboardTextData() As String
'Legt fest, dass bei Auftreten eines Laufzeitfehlers die Steuerung zu der Anweisung geleitet wird, die unmittelbar auf die Anweisung folgt, bei der der Fehler aufgetreten ist und die Ausführung fortgesetzt wird.
On Error Resume Next
'late Binding = no references (erhöht die Durchlaufgeschwindigkeit)
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'Aufruf .GetFromClipboard = Inhalt der Zwischenablage mittels Daten-Objekt aufrufen
Call .GetFromClipboard
'Text/ String aus der Zwischenablage holen und in GetClipboardTextData schreiben
GetClipboardTextData = .GetText()
End With
End Function
|