Leichte Korrektur
01.11.2002 20:32:43
Ramses
Hallo Werner,in der Tat war ein kleiner Fehler drin. Das Range Objekt im Sort-Key wurde von mir falsch definiert.
Hier die korrigierte Version
Sub Find_All_Characters()
Dim Cr As Long, CC As Integer, CC2 As Integer
Dim Nr As Long, NC As Integer
Dim Tstr As String, wks As String
Dim Qe As String, Header As Integer
CC = 1 'Spalte A
CC2 = 2 'Spalte B
NC = 3 'Spalte C; hier werden die neuen Daten geschrieben
Cr = 65536 'Suchbeginn für x-Zeilen in A
Nr = 1 'Schreibbeginn für String in Zeile1 in C
wks = "Tabelle1" 'Name der Tabelle wo die Daten stehen
Tstr = "" 'Variable für String zusammensetzung
ZStr = "" 'Variable um in Zelle zu schreiben
Header = 1 'Keine Überschriften vorhanden
Columns(NC).Select 'Neuer Spalte Textformat zuweisen
Selection.NumberFormat = "@"
Cells(1, 1).Select 'Start des Programms
If Worksheets(wks).Cells(Cr, CC) = "" Then
Cr = Worksheets(wks).Cells(Cr, CC).End(xlUp).Row + 1
End If
Qe = MsgBox("Haben die Spalten einen Überschriftenbereich ?", vbCritical + vbYesNo + vbDefaultButton1, "Sortiervorgang")
'Hier werden die beiden Spalten noch sortiert
'das die Buchstaben mit etwas ordnung auftauchen :-)
If Qe = vbYes Then
Worksheets(wks).Range(Cells(1, CC), Cells(Cr, CC2)).Sort Key1:=Cells(1, CC), _
Order1:=xlAscending, Key2:=Cells(1, CC2), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Header = 2
Nr = 2
Else
Worksheets(wks).Range(Cells(1, 1), Cells(Cr, 2)).Sort Key1:=Cells(1, CC), _
Order1:=xlAscending, Key2:=Cells(1, CC2), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End If
'Beginn der Datensuche
Tstr = Worksheets(wks).Cells(Header, CC) & " " & Worksheets(wks).Cells(Header, CC2)
For i = Header + 1 To Cr
If Worksheets(wks).Cells(i - 1, CC) <> Worksheets(wks).Cells(i, CC) Then
Worksheets(wks).Cells(Nr, NC) = Tstr
Tstr = Worksheets(wks).Cells(i, CC) & " " & Worksheets(wks).Cells(i, CC2)
Nr = Nr + 1
Else
Tstr = Tstr & " " & Worksheets(wks).Cells(i, CC2)
End If
Next i
End Sub
Code eingefügt mit Syntaxhighlighter 1.14
Aber bei xlsort wird gar keine Variable verwendet !!!!???
Deshalb ist mir der Fehler schleierhaft.
Probier mal das aus, ob es jetzt geht.
Gruss Rainer