Hallo,
ich möchte gerne den Inhalt einer Excel Spalte wild durcheinanderwürfeln (ohne seperate Spalte / Sortierung) und dabei die leeren Zellen überspringen (bzw. belassen.)
Über ein Makro würde ich mich sehr freuen.
ich möchte gerne den Inhalt einer Excel Spalte wild
durcheinanderwürfeln (ohne seperate Spalte / Sortierung) und
dabei die leeren Zellen überspringen (bzw. belassen.)
Hallo EP,
in ein Standardmodul wie Modul1:
Sub Misch()
Dim Zei As Long, Z As Long, Zahl
Zei = Cells(Rows.Count, 1).End(xlUp).Row
With Range("T1:T" & Zei)
.FormulaLocal = "=Wenn(a1="""";Zeile();"""")"
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
For Z = 1 To Zei
If Cells(Z, "T") = "" Then
Do
Zahl = Int(Rnd() \* Zei) + 1
Loop While Application.CountIf(Range("T:T"), Zahl) \> 0
Cells(Z, "T").Value = Zahl
End If
Next Z
Range("A1:T" & Zei).Sort Key1:=Range("T1"), Order1:=xlAscending, Header:=xlNo, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("T:T").ClearContents
Range("A1").Select
End Sub
Gruß
Reinhard
Super - vielen Dank
wie muß ich den Makro denn umschreiben, sodass er nur auf Spalte A und E wirkt?
Vielen Dank im voraus,
EP
1 „Gefällt mir“
wie muß ich den Makro denn umschreiben, sodass er nur auf
Spalte A und E wirkt?
Hallo EP,
Option Explicit
'
Sub Misch()
Dim Zei As Long, Z As Long, Zahl
Zei = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
With Range("E1:E" & Zei)
.FormulaLocal = "=Wenn(a1="""";Zeile();"""")"
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
For Z = 1 To Zei
If Cells(Z, "E") = "" Then
Do
Zahl = Int(Rnd() \* Zei) + 1
Loop While Application.CountIf(Range("E:E"), Zahl) \> 0
Cells(Z, "E").Value = Zahl
End If
Next Z
Range("A1:E" & Zei).Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlNo, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E:E").ClearContents
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
Hallo Reinhard,
nun mischt er Spalte A-D durch und löscht die Inhalte in Spalte E.
Wenns 'ne Möglichkeit gäbe sollte er nur Spalte A und separat (also nicht untereinander) Spalte E mischen.
B+C sollte nicht angerührt werden.
Vielen Dank,
EP
nun mischt er Spalte A-D durch und löscht die Inhalte in
Spalte E.Wenns 'ne Möglichkeit gäbe sollte er nur Spalte A und separat
(also nicht untereinander) Spalte E mischen.
B+C sollte nicht angerührt werden.
Hallo EP,
damit ichs vollkommen richtig verstehe.
Die Leerzellen in A sollen dort bleiben wo sie sind, also in der gleichen Zeile. Alle anderen Zellinhalte von A sollen dann gemischt werden und in anderen Zellen/zeilen stehen?
Unabhängig vom Positiostausch in A soll dan das Gleiche mit Spalte E stattfinden mit gleichen Regeln?
Gut, aus reinen Schnelligkeitsgründen würde ich gerne einiges davon zwar durch Vba aber mit Excelformeln in einer Hilfsspalte lösen.
Excelformeln sind zigmal schneller als mit Vba in einer Schleife viele Zellen zu durchlaufen.
Welche Spalten, am besten zwei sind frei, auch in Zukunft?
Keine Sorge, nach dem Makro sind die Hilfsspalten leer wie vorher, ich will nur nix von deinen Daten überschreiben.
Gruß
Reinhard
Hallo Reinhard,
Genau, die Inhalte der Zellen der Spalte A sollten innerhalb der Spalte wild durchgemischt werden - Leerzellen aber dort verweilen wo sie sind.
Selbiges soll getrennt mit Spalte E passieren.
Hilfsspalten wären z.B. Y & Z
Vielen Dank für die Mühe und alles 
Grüße,
EP
Genau, die Inhalte der Zellen der Spalte A sollten innerhalb
der Spalte wild durchgemischt werden - Leerzellen aber dort
verweilen wo sie sind.
Selbiges soll getrennt mit Spalte E passieren.Hilfsspalten wären z.B. Y & Z
Hallo EP,
X und Y werden nicht gebraucht/behelligt, ich habe den Ansatz geändert.
Option Explicit
'
Sub Misch()
Call Mischfunktion(1) ' 1 = 1te Spalte=A
Call Mischfunktion(5) ' 5 = 5te Spalte=E
End Sub
'
Sub Mischfunktion(Spa As Integer)
Dim Zei As Long, Z As Long, Zahl
Zei = Cells(Rows.Count, Spa).End(xlUp).Row
Application.ScreenUpdating = False
Columns(Spa).Insert
With Range(Cells(1, Spa), Cells(Zei, Spa))
.FormulaLocal = "=Wenn(" & Chr(65 + Spa) & "1="""";Zeile();"""")"
.Copy
.PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
For Z = 1 To Zei
If Cells(Z, Spa) = "" Then
Do
Zahl = Int(Rnd() \* Zei) + 1
Loop While Application.CountIf(Columns(Spa), Zahl) \> 0
Cells(Z, Spa).Value = Zahl
End If
Next Z
Range(Cells(1, Spa), Cells(Zei, Spa + 1)).Sort Key1:=Cells(1, Spa), Order1:=xlAscending, Header:=xlNo, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(Spa).Delete
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
perfekt!
Nun sieht es sehr gut aus
Das einzige, was ich blöderweiße aber auch nicht erwähnt habe ist, dass der Makro wegen der Tabellenüberschrift (a1 + e1) erst ab Zelle Zwei anfangen soll.
Vielen Dank für deine Geduld und Mühe!