Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
04.03.2022 09:46:17 |
VBA_Beginner |
|
|
Text in Zelle aufsplitten und in gesonderte Zellen einfügen |
04.03.2022 18:01:43 |
Gast8173 |
|
|
|
07.03.2022 06:53:05 |
Èintacht00 |
|
|
|
07.03.2022 07:12:57 |
Eintracht00 |
|
|
|
07.03.2022 18:33:00 |
Gast66835 |
|
|
|
08.03.2022 07:30:21 |
Eintracht00 |
|
|
Von:
Gast8173 |
Datum:
04.03.2022 18:01:43 |
Views:
815 |
Rating:
|
Antwort:
|
Thema:
Text in Zelle aufsplitten und in gesonderte Zellen einfügen |
Viele Wege führen nach Rom.
- den Fließtext in den Zwischenspeicher (STRG+C) kopieren
- in Excel den Bereich mit den Bezeichnern auswählen
- der Bereich muss einspaltig sein
- und muss mind. 2 Zellen beinhalten
- Makro ExtractParamsFromClipboard abdrücken
- neben dem ausgewählten Bereich wird dann passend zum Bezeichner der Wert eingetragen
Option Explicit
Public Sub ExtractParamsFromClipboard()
Dim rngParams As Excel.Range
Dim strData As String
Set rngParams = Selection
strData = GetClipboardTextData()
If strData = "" Then
Call MsgBox("Keine Daten in der Zwischenablage gefunden.", vbExclamation)
Exit Sub
End If
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
Dim vntParam As Variant
Dim dicParams As Object
Set dicParams = CreateObject("Scripting.Dictionary")
For Each vntParam In rngParams.Cells
dicParams(vntParam) = Empty
Next
Call ExtractParams(strData, dicParams)
For Each vntParam In rngParams.Cells
vntParam.Offset(0, 1).Value = dicParams(vntParam.Value)
Next
Call MsgBox("Extraktion fertsch.", vbInformation)
End Sub
Private Sub ExtractParams(Expr As String, ByRef ParamDictionary As Object)
Dim objMatch As Object
Dim strPattern As String
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.MultiLine = True
strPattern = Join(ParamDictionary.Keys(), vbNullChar)
.Pattern = "([-[\]{}()*+?.,\\^$|#\s])" '
strPattern = .Replace(strPattern, "\$1") 'escaping
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
Public Function GetClipboardTextData() As String
On Error Resume Next
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Call .GetFromClipboard
GetClipboardTextData = .GetText()
End With
End Function
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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
|
|
04.03.2022 09:46:17 |
VBA_Beginner |
|
|
Text in Zelle aufsplitten und in gesonderte Zellen einfügen |
04.03.2022 18:01:43 |
Gast8173 |
|
|
|
07.03.2022 06:53:05 |
Èintacht00 |
|
|
|
07.03.2022 07:12:57 |
Eintracht00 |
|
|
|
07.03.2022 18:33:00 |
Gast66835 |
|
|
|
08.03.2022 07:30:21 |
Eintracht00 |
|
|