1 a
1
1 b
2
3 c
3 h
3 j
4 k
jetz möchte ich das in einer Zeile in n Spalten haben
1 a b
2
3 c h j
4 k
wer kann mir helfen
probier mal folgendes:
Sub Find_All_Characters()
Code eingefügt mit Syntaxhighlighter 1.14
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:=Range(Cells(1, CC)), _
Order1:=xlAscending, Key2:=Range(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:=Range(Cells(1, CC)), _
Order1:=xlAscending, Key2:=Range(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
Gruss Rainer
ich hab Deine Aufabe etwas anders verstanden und mit folgendem Code gelöst (der Bereich fängt bei A1 an):
Gruß
Peter
äußerst interessante Variante; ich erhalte allerdings bei "xlSortNormal" eine Fehlermeldung "Variable nicht definiert" - was muß ich tun?
Oder liegts an meiner EXCEL-Version?
mfg und besten Dank für eine Rückmeldung
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()
Code eingefügt mit Syntaxhighlighter 1.14
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
Aber bei xlsort wird gar keine Variable verwendet !!!!???
Deshalb ist mir der Fehler schleierhaft.
Probier mal das aus, ob es jetzt geht.
Gruss Rainer