Clever-Excel-Forum

Hallo zusammen,

ich such mal wieder eine Lösung um z.B den Inhalt einer MsgBox in ein Text-File zu schreiben.
Das beigefügte Makro findet alle doppelten Eintäge in der Spalte 1 der Tabelle.
Diese Fundstellen möchte ich auflisten....was mir mit einer MsgBox auch gelingt, auch die Textdatei wird geschrieben.
Die Fundstellen im Textfile sollen aber immer durch einen Zeilenumbruch getrennt sein.

Kann mir jemand helfen bzw. den Code so korrigieren damit das so funktioniert? Wäre super!

Code:
Sub doppelte_Eintraege_finden()

  Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As Integer

  Dim str_Auswahl As Variant

  Dim Datei As String

  Datei = "C:\Users\User\Documents\Test.txt"

  Close #1

  Open Datei For Output As #1

  int_erste_Zeile = 7

  int_Spalte = 1

  int_letzte_Zeile = Cells(Cells.Rows.Count, int_Spalte).End(xlUp).Row

  For int_x = int_letzte_Zeile To int_erste_Zeile Step -1

    If Range(Cells(int_x, int_Spalte + 1), Cells(int_x, int_Spalte + 1)).Text <> "X" Then

      If WorksheetFunction.CountIf(Range(Cells(int_erste_Zeile, int_Spalte), Cells(int_letzte_Zeile, int_Spalte)), Cells(int_x, int_Spalte)) > 1 Then

        str_Auswahl = str_Auswahl & "Zelle: " & Cells(int_x, int_Spalte).Address & "mit Inhalt: " & Cells(int_x, int_Spalte).Value & Chr(13)

        'Cells(int_x, int_Spalte).Value = ""

        Cells(int_x, int_Spalte).Interior.ColorIndex = 6

      End If

    End If

  Next int_x

  MsgBox "folgende Zellen sind doppelt und wurden gelöscht" & Chr(13) & str_Auswahl

  Print #1, "folgende Zellen sind doppelt und wurden gelöscht" & Chr(13) & str_Auswahl

  Close #1

End Sub

Habe es selbst gelöst.....

Code:
Sub doppelte_Eintraege_finden()

  Dim int_Spalte As Integer, int_erste_Zeile As Integer, int_letzte_Zeile As Long, int_x As Integer

  Dim str_Auswahl As Variant

  Dim Datei As String

  Datei = "C:\Users\User\Documents\Test.txt"

  Close #1

  Open Datei For Output As #1

Print #1, "Folgende Zellen sind doppelt und wurden eingefärbt";

  int_erste_Zeile = 7

  int_Spalte = 1

  int_letzte_Zeile = Cells(Cells.Rows.Count, int_Spalte).End(xlUp).Row

  For int_x = int_letzte_Zeile To int_erste_Zeile Step -1

    If Range(Cells(int_x, int_Spalte + 1), Cells(int_x, int_Spalte + 1)).Text <> "X" Then

      If WorksheetFunction.CountIf(Range(Cells(int_erste_Zeile, int_Spalte), Cells(int_letzte_Zeile, int_Spalte)), Cells(int_x, int_Spalte)) > 1 Then

        str_Auswahl = str_Auswahl & "Zelle: " & Cells(int_x, int_Spalte).Address & "mit Inhalt: " & Cells(int_x, int_Spalte).Value & Chr(13)

         Cells(int_x, int_Spalte).Interior.ColorIndex = 6

          Print #1, str_Auswahl

            str_Auswahl = ""

      End If

    End If

  Next int_x

  Close #1

End Sub

sharky51

sharky51