Suchen-Ersetzen EXCEL Makro?

Option Explicit
Option Compare Text

Const Sheet1 = "Tabelle1"  
Const Sheet2 = "Tabelle2"  

Sub SearchAndReplace()
    Dim Wks1 As Worksheet, Wks2 As Worksheet, c As Range, d As Range
    
    Set Wks1 = Sheets(Sheet1):  Set Wks2 = Sheets(Sheet2)
    
    For Each c In Wks2.Range("C3:C" & Wks2.Cells(Wks2.Rows.Count, "C").End(xlUp).Row)  
        If Not IsEmpty(c) Then
            Set d = Wks1.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlWhole)  
            If d Is Nothing Then
                c.Offset(0, 1) = "Nein"  
            Else
                d.Value = c.Offset(0, -1):  c.Offset(0, 1) = "Ja"  
            End If
        End If
    Next
End Sub

Option Explicit
Option Compare Text

Const Sheet1 = "Tabelle1"  
Const Sheet2 = "Tabelle2"  

Sub SearchAndReplace()
    Dim Wks1 As Worksheet, Wks2 As Worksheet, c As Range, d As Range
    
    Set Wks1 = Sheets(Sheet1):  Set Wks2 = Sheets(Sheet2)
    
    For Each c In Wks2.Range("C3:C" & Wks2.Cells(Wks2.Rows.Count, "C").End(xlUp).Row)  
        If Not IsEmpty(c) Then
            Set d = Wks1.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlPart)  
            If d Is Nothing Then
                c.Offset(0, 1) = "Nein"  
            Else
                d.Value = Replace(d, c, c.Offset(0, -1)):  c.Offset(0, 1) = "Ja"  
            End If
        End If
    Next
End Sub

Option Explicit
Option Compare Text

Const Msg1 = "Es wurde kein gültiger Bereich markiert!"  

Sub ExportFunction()
    Dim Wks As Worksheet, Wkb As Workbook, Target As String, WkbPath As Variant
    
    Target = Selection.Address
    
    If InStr(Target, ":") = 0 Or UBound(Split(Target, "$")) <> 4 Then  
        MsgBox Msg1, vbExclamation, "Fehler":  Exit Sub  
    End If
    
    Set Wks = ActiveWorkbook.ActiveSheet:  Set Wkb = Workbooks.Add
    
    Wks.Range(Target).Copy Destination:=Wkb.ActiveSheet.Range("A1")  
   
    WkbPath = Application.GetSaveAsFilename(InitialFileName:="Export", _  
                    fileFilter:="CSV (*.csv),*.csv,XML (*.xml), *.xml")  
                    
    Application.DisplayAlerts = False
    
    If WkbPath = False Then
        Wkb.Saved = True
    ElseIf WkbPath Like "*.csv" Then  
        Wkb.SaveAs WkbPath, xlCSV
    ElseIf WkbPath Like "*.xml" Then  
        Wkb.SaveAs WkbPath, xlXMLSpreadsheet
    Else
        Wkb.Saved = True
    End If

    Wkb.Close
    Application.DisplayAlerts = True
End Sub

Dim Fso As New FileSystemObject, File As TextStream
Set File = Fso.OpenTextFile(...)

Const Default = "C7:C55416"  

Const Msg1 = "Bitte den kompletten Dateipfad angeben:"  
Const Msg2 = "Bitte den Exportbereich im Format 'C7:H17' angeben:"  
Const Msg3 = "Die Eingaben waren unvollständig!"  
Const Msg4 = "Der Exportvorgang ist abgeschlossen!"  

Private Sub Export_Click()
    Dim Fso As Object, File As Object, TextArray As Variant
    Dim Bereich As Range, Zeile As Range, Zelle As Range
    Dim Dateipfad As String, Mappepfad As String, RngExport As String
    Dim SpalteBeg As Integer, SpalteEnd As Integer
    
    Mappepfad = ThisWorkbook.FullName
    Mappepfad = Replace(Mappepfad, ".xls", ".csv")  
    
    Dateipfad = InputBox(Msg1, "CSV-Export", Mappepfad)  
    RngExport = InputBox(Msg2, "CSV-Export", Default)  
    
    If Dateipfad = "" Or RngExport = "" Then  
        MsgBox Msg3, vbExclamation, "CSV-Export": Exit Sub  
    End If
    
    Set Bereich = Range(RngExport)
    
    SpalteBeg = Bereich.Column
    SpalteEnd = SpalteBeg + Bereich.Columns.Count - 1
    
    ReDim TextArray(SpalteBeg To SpalteEnd) As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    Set File = Fso.CreateTextFile(Dateipfad)
    
    For Each Zeile In Bereich.Rows
        For Each Zelle In Zeile.Cells
            TextArray(Zelle.Column) = Zelle.Text
        Next
        File.WriteLine Join(TextArray, Chr(1))
    Next
    
    File.Close:  Set Fso = Nothing
    
    MsgBox Msg4, vbInformation, "CSV-Export"  
End Sub

Const Default = "C7"  

Const Msg1 = "Bitte die erste Zelle im Format 'C7' angeben:"  
Const Msg2 = "Die Eingaben waren unvollständig!"  

Private Sub Import_Click()
    Dim Dateipfad As Variant, RngImport As String
     
    Dateipfad = Application.GetOpenFilename("CSV (*.csv),*.csv")  
    
    RngImport = InputBox(Msg1, "CSV-Import", Default)  
    
    If Dateipfad = False Or RngImport = "" Then  
        MsgBox Msg2, vbExclamation, "CSV-Import":  Exit Sub  
    End If
    
    Application.ScreenUpdating = False
    
    ActiveSheet.Cells.ClearContents
    
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dateipfad, Destination:=Range(RngImport))  
        .AdjustColumnWidth = True  'Spaltenbreite automatisch anpassen True/False  
        .TextFilePlatform = 1252
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = Chr(1)
        .Refresh BackgroundQuery:=False
        .Delete
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub QueryTablesDelete()
    Dim QT As QueryTable
    For Each QT In ActiveSheet.QueryTables:  QT.Delete:  Next
End Sub

Option Explicit

Const Zeile1 = 7
Const Spalte = "C"  

Const Msg1 = "Bitte den kompletten Dateipfad angeben:"  
Const Msg2 = "Es wurde keine Datei angegeben!"  
Const Msg3 = "Der Exportvorgang ist abgeschlossen!"  

Private Sub Export_Click()
    Dim Fso As Object, File As Object, Zelle As Range, Text As String
    Dim Dateipfad As String, Mappepfad As String, EndLine As Long
    
    Mappepfad = ThisWorkbook.FullName
    Mappepfad = Replace(Mappepfad, ".xls", ".txt")  
    
    Dateipfad = InputBox(Msg1, "Text-Export", Mappepfad)  
    
    If Dateipfad = "" Then MsgBox Msg2, vbExclamation, "Text-Export":  Exit Sub  
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    Set File = Fso.CreateTextFile(Dateipfad)
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each Zelle In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        File.WriteLine Zelle.Text
    Next
    
    File.Close:  Set Fso = Nothing
    
    MsgBox Msg3, vbInformation, "Text-Export"  
End Sub

Option Explicit

Const Zeile1 = 7
Const Spalte = "C"  

Const Msg = "Es wurde keine Datei angegeben!"  

Private Sub Import_Click()
    Dim Fso As Object, File As Object, Dateipfad As Variant, Zeile As Long
    
    Dateipfad = Application.GetOpenFilename("Text (*.txt),*.txt")  
    
    If Dateipfad = False Then
        MsgBox Msg, vbExclamation, "Text-Import":  Exit Sub  
    End If
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    Set File = Fso.OpenTextFile(Dateipfad)
    
    Zeile = Zeile1
    
    ActiveSheet.Columns(Spalte).Cells.ClearContents
    
    Application.ScreenUpdating = False
    
    Do Until File.AtEndOfStream
        Cells(Zeile, Spalte) = File.ReadLine:  Zeile = Zeile + 1
    Loop
    
    Application.ScreenUpdating = True
    
    File.Close:  Set Fso = Nothing
End Sub