Zahlen zufällig anordnen

Hallo und schönen Abend,
ich suche eine VBA-Lösung für ein Problem, das sich besser mit der Beispieltabelle erklären lässt.
Hier vorarb eine Kurzbeschreibung:
Der Bereich ist immer gleich, er umfasst die Zellen B4:C183.
Darin sind unterschiedlich viele Zahlen angeführt, immer 2 Zahlen nebeneinander. Es sind aber keine Zahlenpaare und haben miteinander nichts zu tun.
Die Positionen der Zahlen sind immer anders.
Hier z.B. sind die ersten Zahlen in Zeile 39.
Ich suche eine Makro-Lösung für folgendes Problem:
Alle Zahlen sollen untereinander zufällig getauscht werden, die Positionen der befüllten Zellen sollen sich aber nicht ändern.
Oder anders ausgedrückt: Zellen die vorher leer waren müssen auch nachher leer sein.
Und hier die Arbeitsmappe:
https://www.herber.de/bbs/user/117505.xlsx
Danke für die Hilfe, Servus Walter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Walter,
eine Möglichkeit.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub switchNumbers()
Dim objNumbersRange As Object, objNumbers As Object, objN As Object
Dim varNumbers() As Variant, lngIndex As Long, lngRnd As Long

With Sheets("Tabelle1")
  Set objNumbersRange = Range("B4:C183")
  If Application.Count(objNumbersRange) > 0 Then
    Set objNumbers = objNumbersRange.SpecialCells(xlCellTypeConstants, 1)
    If Not objNumbers Is Nothing Then
      Redim varNumbers(1 To objNumbers.Count)
      For Each objN In objNumbers
        lngIndex = lngIndex + 1
        varNumbers(lngIndex) = objN.Value
      Next
      Randomize
      For Each objN In objNumbers
        lngRnd = Int(UBound(varNumbers) * Rnd + 1)
        objN = varNumbers(lngRnd)
        If UBound(varNumbers) > 1 Then
          varNumbers(lngRnd) = varNumbers(UBound(varNumbers))
          Redim Preserve varNumbers(1 To UBound(varNumbers) - 1)
        End If
      Next
    End If
  End If
End With

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

154 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zahlen zufällig anordnen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

154 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread