Thema Datum  Von Nutzer Rating
Antwort
04.01.2017 10:22:04 excelboy33
NotSolved
04.01.2017 10:38:00 Holger
NotSolved
04.01.2017 10:49:57 excelboy33
NotSolved
Blau Excel Leerzeichen Trimmen und bestimmtes Wort kopieren
 04.01.2017 13:03:46 SJ
*****
NotSolved
04.01.2017 13:58:57 excelboy33
NotSolved
04.01.2017 15:58:41 Gast69706
NotSolved
05.01.2017 07:44:55 excelboy33
NotSolved
04.01.2017 17:45:53 SJ
*****
NotSolved
05.01.2017 07:44:18 excelboy33
NotSolved
05.01.2017 15:30:50 SJ
NotSolved
06.01.2017 07:49:30 excelboy33
NotSolved
08.01.2017 17:58:44 SJ
NotSolved
09.01.2017 09:36:34 excelboy33
NotSolved
09.01.2017 11:43:07 SJ
NotSolved
09.01.2017 12:46:37 excelboy33
NotSolved
09.01.2017 12:55:02 SJ
NotSolved
09.01.2017 13:13:17 Gast95461
NotSolved
09.01.2017 13:21:18 excelboy33
NotSolved
09.01.2017 13:23:01 SJ
NotSolved
09.01.2017 13:54:20 excelboy33
NotSolved
09.01.2017 14:14:59 SJ
NotSolved
09.01.2017 14:36:25 excelboy33
NotSolved
09.01.2017 14:47:31 SJ
NotSolved
09.01.2017 14:54:24 excelboy33
NotSolved
09.01.2017 14:56:57 SJ
NotSolved

Ansicht des Beitrags:
Von:
SJ		 Datum:
04.01.2017 13:03:46		 Views:
983		 Rating:
     
Antwort:
  Ja
Thema:
Excel Leerzeichen Trimmen und bestimmtes Wort kopieren

Guten Morgen,

eine Möglichkeit:

Option Explicit
'Verweis auf "Microsoft VBScript Regular Expressions 5.5" setzen

Private Const REGEXPATTERN As String = "from\s" 'ggfs. anpassen: "https://regex101.com/"
Private Const TABLENAME_FROM As String = "Tabelle1" 'anpassen
Private Const TABLENAME_TO As String = "Tabelle2" 'anpassen

Public Sub search_and_transfer()
    Dim regEx As New RegExp
    With regEx
        .Pattern = REGEXPATTERN
        .Global = True
        .IgnoreCase = True 'ggfs. anpassen (Groß- Kleinschreibung ignorieren)
        .MultiLine = False
    End With
    
    Dim l As Long
    l = 1
    
    With Worksheets(TABLENAME_FROM)
        Do While Not .Cells(l, 1).Value = vbNullString
            If regEx.Test(.Cells(l, 1).Value) Then
                Worksheets(TABLENAME_TO).Cells(get_next_empty_row, 1).Value = regEx.Replace(.Cells(l, 1), "")
            End If
            l = l + 1
        Loop
    End With
    
    Set regEx = Nothing
End Sub

Private Function get_next_empty_row() As Long
    Dim l As Long
    l = 1
    
    With Worksheets(TABLENAME_TO)
        Do While Not .Cells(l, 1).Value = vbNullString
            l = l + 1
        Loop
    End With
    
    get_next_empty_row = l
End Function

Gruß

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
04.01.2017 10:22:04 excelboy33
NotSolved
04.01.2017 10:38:00 Holger
NotSolved
04.01.2017 10:49:57 excelboy33
NotSolved
Blau Excel Leerzeichen Trimmen und bestimmtes Wort kopieren
 04.01.2017 13:03:46 SJ
*****
NotSolved
04.01.2017 13:58:57 excelboy33
NotSolved
04.01.2017 15:58:41 Gast69706
NotSolved
05.01.2017 07:44:55 excelboy33
NotSolved
04.01.2017 17:45:53 SJ
*****
NotSolved
05.01.2017 07:44:18 excelboy33
NotSolved
05.01.2017 15:30:50 SJ
NotSolved
06.01.2017 07:49:30 excelboy33
NotSolved
08.01.2017 17:58:44 SJ
NotSolved
09.01.2017 09:36:34 excelboy33
NotSolved
09.01.2017 11:43:07 SJ
NotSolved
09.01.2017 12:46:37 excelboy33
NotSolved
09.01.2017 12:55:02 SJ
NotSolved
09.01.2017 13:13:17 Gast95461
NotSolved
09.01.2017 13:21:18 excelboy33
NotSolved
09.01.2017 13:23:01 SJ
NotSolved
09.01.2017 13:54:20 excelboy33
NotSolved
09.01.2017 14:14:59 SJ
NotSolved
09.01.2017 14:36:25 excelboy33
NotSolved
09.01.2017 14:47:31 SJ
NotSolved
09.01.2017 14:54:24 excelboy33
NotSolved
09.01.2017 14:56:57 SJ
NotSolved