Auswahlmoeglichkeit Sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub AuswahlKopieren() Dim wksQ As Worksheet, wksZ As Worksheet, ZeileQ As Long, ZeileZ As Long Set wksQ = Worksheets("Auswahl") Set wksZ = Worksheets("Auswertung") With wksZ ZeileZ = .Cells(.Rows.Count, 2).End(xlUp).Row If ZeileZ > 1 Then .Range(.Cells(2, 2), .Cells(ZeileZ, 3)).ClearContents End If ZeileZ = 1 End With With wksQ For ZeileQ = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row If UCase(.Cells(ZeileQ, 3)) = "X" Then ZeileZ = ZeileZ + 1 wksZ.Cells(ZeileZ, 2).Value = .Cells(ZeileZ, 2).Value End If Next End With With wksZ ZeileZ = .Cells(.Rows.Count, 2).End(xlUp).Row If ZeileZ > 2 Then 'Werte sortieren in Spalte B With .Range(.Cells(2, 2), .Cells(ZeileZ, 2)) .Sort Key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo End With 'Zellfarbe neu zuordnen For ZeileZ = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row With .Cells(ZeileZ, 2) If ZeileZ Mod 2 = 0 Then .Interior.ColorIndex = xlColorIndexNone Else .Interior.Color = 14277081 End If End With Next End If .Activate End With End Sub

Hallo Robin!
Hoffe Du kannst damit was anfangen. Hab damit nur ganz "quick-and-dirty" versucht umzusetzen, was ich aus Deiner Aufgabe verstanden habe. Zur Erklärung: In Tabellenblatt 1 steht eine Begriffsliste - Begriffe werden ausgewählt durch setzen eines "x" in die Zelle rechts daneben. Dann gehe ich die Begriffsliste von oben nach unten durch, und immer wenn ein "x" gefunden wird, wird der zugehörige Begriff in Tabellenblatt zwei geschrieben (an die nächste Zeilenposition - wird mit durchgezählt). Zum Schluss sortiere ich die Begriff in Tabellenblatt 2 alphabetisch.
Deine Bsp-Datei konnte ich auf dem Server leider nicht mehr finden.

Sub TestAuswahl()
Dim i, j As Integer
Dim Ende As Integer
Ende = Sheets(1).Cells(1, 2).End(xlDown).Row
j = 1
For i = 1 To Ende
Select Case Sheets(1).Cells(i, 3).Value
Case Is = "x"
Sheets(2).Cells(j, 1).Value = Sheets(1).Cells(i, 2).Value
j = j + 1
Case Else
End Select
Next i
Sheets(2).Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select
Sheets(2).Sort.SortFields.Clear
Sheets(2).Sort.SortFields.Add Key:=Range("A1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets(2).Sort
.SetRange Range(Cells(1, 1), Cells(1, 1).End(xlDown))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Liebe Grüße
Michael

Wow, ich danke euch dreien sehr, dass ging echt schnell.
Ich habe bereits alles getestet und bin am verstehen wie das ganze von statten geht.
Klaus M.vdT., ich danke dir für diese simple und schnelle Lösung der Funktion Index, ich habe sie schon öfters gelesen, doch meistens eher überlesen. Ich werde sie mir aber nun aneignen, anscheint fehlen mir noch ein paar wertvolle Funktionen, leider hat mir bei deiner Lösung das Sortieren gefehlt und in einer Tabelle macht es mir auch gerade Probleme es zu Sortieren.
Franz, deine Lösung war auf dem ersten Blick schwer zu verstehen, selbst jetzt hab ich noch ein paar Fragezeichen im Kopf. Deine Programmierung ist aber trotzdem sehr gut und funktioniert perfekt, dazu kommt das sie sich von selbst erweitert.
P.S. Das einfärben wäre nicht nötig gewesen, trotzdem danke, kannte ich nicht. *hehe* ~ merk
Michael, auch dir vielen Dank, ich musste deinen Programmcode zwar ein bisschen anpassen, aber du hattest ja leider meine Datei nicht laden können. Dafür war auch dein Code ziemlich gut und leicht verständlich.
Ich danke euch allen sehr ihr habt mir sehr geholfen, welchen Code ich anwenden werde kann ich jetzt noch nicht sagen, ich werde sie an meiner Hauptdatei probieren und dann entscheiden welche leichter, flexibler und besser ist.
MfG
RoHb
P.S. Anscheint war mein Auswahlfunktionsmakro gut genug. *g*

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread