Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mischen eines Tabellenblattes - Mehrdimensionale Felder
#1
Hallo liebe VBA Profis,

ich möchte gerne die Zellen auf meinem Tabellenblatt mischen. Dazu habe ich mir folgendes Makro
geschrieben:

Code:
Public Sub Mischen()

Dim i As Variant, fFeld() As Variant, iTemp As Variant, iZ As Variant
Dim Werte() As Variant
    
    C = ActiveCell.Row - 1
    
    anz = InputBox("Anzahl der zu mischenden Werte = ")
    
    ReDim fFeld(anz)
    For i = 1 To anz
        fFeld(i) = i
    Next i
      
    For i = anz To 1 Step -1
        Randomize Timer
        iZ = Int((i * Rnd) + 1)
        iTemp = fFeld(iZ)
        fFeld(iZ) = fFeld(i)
        fFeld(i) = iTemp
    Next i
    
    For a = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
    ReDim Werte(anz)
    For i = 1 To anz
    Werte(i) = Cells(i + C, a)
    Next i
    
    For i = 1 To anz
        'Cells(i, 2) = fFeld(i)
        Cells(fFeld(i) + C, a) = Werte(i)
    Next i
    Next a
    
End Sub

Das Problem bei dem jetzigen Makro ist dass durch das Durchlaufen der Schleife

For a = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
..
..
Next a

die Performance nicht so besonders ist. Bei grosser Zeilenanzahl habe ich schnell ein Sanduhrprogramm. Wie kann der Code verbessert werden, dass mit optimaler Geschwindigkeit gemischt wird? Meine Idee wäre
irgendwie ein mehrdimensionales Feld zu entwickeln, hab bisher aber keine Ahnung bezüglich dessen Umsetzung. Bin aber auch für alle anderen Ideen offen.
Antworten Top
#2
Hallo Kathrin,

ich bin mir nicht sicher, ob Du mit Deiner Frage darauf abzielst, die Einträge aller Zeilen und Spalten der Excel-Tabelle zu mischen oder nur innerhalb der jeweiligen Spalte oder ...

Ich habe hier mal in Deinem code ein paar Änderungen vorgenommen, mit denen man alle Zeilen und Spalten mischen würde. Siehe dazu die Kommentare im code.

Variablendeklarationen und anderes sind sicher auch noch verbesserungswürdig ... Hier aber erst mal der code. Unten müsste dann noch die Übertragung des Arrays in die Tabelle dran. Getestet hab ich das erst mal nur mit zwei Spalten.

Code:
Public Sub Mischen()

Dim i As Variant, a As Variant, fFeld() As Variant, iTemp As Variant, sTemp As Variant, tTemp As Variant, iZ As Variant
Dim Werte() As Variant
    
    C = ActiveCell.Row - 1
    
'    anz = InputBox("Anzahl der zu mischenden Werte = ")
    
    'benutzten Bereich in Array einlesen
    sTemp = ActiveSheet.UsedRange
    'Anzahl Eintraege ermitteln anhand "Spalten" und "Zeilen"
    anz = UBound(sTemp, 1) * UBound(sTemp, 2)
    'Zielarray dimensionieren
    ReDim tTemp(1 To UBound(sTemp, 1), 1 To UBound(sTemp, 2))
    
    ReDim fFeld(1 To anz)
    For i = 1 To anz
        fFeld(i) = i
    Next i
      
    For i = anz To 1 Step -1
        Randomize Timer
        iZ = Int((i * Rnd) + 1)
        iTemp = fFeld(iZ)
        fFeld(iZ) = fFeld(i)
        fFeld(i) = iTemp
    Next i
    
    'Schleife ueber alle Zufallszahlen
    For a = 1 To UBound(fFeld)
        'Uebernahme des fFeld(a) Eintrages in das a-te Feld des Zielarrays.
        'Zielposition finden:
        'Die Position der "Zeile" wird anhand des Restwertes der Division des fFeld(a) Eintrages durch die Anzahl der
        '"Spalten" ermittelt. Da bei der letzten "Zeile" der Restwert 0 ist, muss er durch die Zeilenzahl ersetzt werden.
        'Die "Spalte" ergibt sich durch Aufrunden  der Division des fFeld(a) Eintrages durch die Anzahl der
        '"Spalten"
        'Queleintrag finden:
        'Berechnung wie Zielposition, jedoch mit a statt fFeld(a)
        tTemp(Replace(fFeld(a) Mod UBound(sTemp, 1), 0, UBound(sTemp, 1)), WorksheetFunction.RoundUp((fFeld(a) / UBound(sTemp, 1)), 0)) = _
        sTemp(Replace(a Mod UBound(sTemp, 1), 0, UBound(sTemp, 1)), WorksheetFunction.RoundUp((a / UBound(sTemp, 1)), 0))
    Next a
    
    'ab hier Uebertragung auf das Tabellenblatt
    
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Hallo André,
interessante Idee die du da vorstellst. Aber leider
läuft der Code noch nicht.
Antworten Top
#4
Hallo Kathrin,

schreib mal bitte, wo es klemmt bzw. stelle den kompletten code ein, falls Du was ergänzt oder geändert hast.

Für die Übertragung der gemischten Daten kannst Du z.B. so vorgehen. Ich habe es hier auf ein anderes Blatt ausgegeben.

Sheets("Tabelle2").Cells(1, 1).Resize(UBound(sTemp, 1), UBound(sTemp, 2)) = tTemp
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#5
Hallo André,

der Compiler unterstreicht genau diese Zeilen gelb:
tTemp(Replace(fFeld(a) Mod UBound(sTemp, 1), 0, UBound(sTemp, 1)), WorksheetFunction.RoundUp((fFeld(a) / UBound(sTemp, 1)), 0)) = _
sTemp(Replace(a Mod UBound(sTemp, 1), 0, UBound(sTemp, 1)), WorksheetFunction.RoundUp((a / UBound(sTemp, 1)), 0))

(P.S. Verwende eine 64 Bit Office Version, weiß nicht ob das damit zusammenhängen könnte.)
Antworten Top
#6
Hallo Kathrin,

es könnte daran liegen, dass bei Replace ein Text erwartet oder erzeugt wird und das 32er Office da etwas toleranter ist.
Aber was wir letztens öfter hatten - eventuell geht vor dem WorksheetFunction noch Application. (mit dem Punkt)
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#7
Hallo Zusammen,

habe mich auch mal daran versucht ohne Replace, Mod und RoundUp:

Code:
Public Sub Mischen_Kuwer()
  Dim i As Long, iZ As Long, j As Long, k As Long, lngAnzahl As Long
  Dim fFeld() As Variant, iTemp As Variant, sTemp As Variant, tTemp As Variant
  Dim Werte() As Variant
    
  'Bereich in Array einlesen
  sTemp = Tabelle5.Range("A1:C6").Value
  'Anzahl Eintraege ermitteln anhand "Spalten" und "Zeilen"
  lngAnzahl = UBound(sTemp, 1) * UBound(sTemp, 2)
  'Zielarray dimensionieren
  ReDim tTemp(1 To UBound(sTemp, 1), 1 To UBound(sTemp, 2))
  
  ReDim fFeld(1 To lngAnzahl, 1 To 3)
  
  For j = 1 To UBound(sTemp, 2)
    For i = 1 To UBound(sTemp, 1)
      k = k + 1
      fFeld(k, 1) = k
      fFeld(k, 2) = i
      fFeld(k, 3) = j
    Next i
  Next j
    
  For i = lngAnzahl To 1 Step -1
    Randomize Timer
    iZ = Int((i * Rnd) + 1)
    iTemp = fFeld(iZ, 1)
    fFeld(iZ, 1) = fFeld(i, 1)
    fFeld(i, 1) = iTemp
  Next i
  
  k = 0
  For j = 1 To UBound(tTemp, 2)
    For i = 1 To UBound(tTemp, 1)
      k = k + 1
      tTemp(i, j) = sTemp(fFeld(fFeld(k, 1), 2), fFeld(fFeld(k, 1), 3))
    Next i
  Next j
  
  'ab hier Uebertragung auf das Tabellenblatt
  Tabelle4.Cells(20, 1).Resize(UBound(tTemp, 1), UBound(tTemp, 2)).Value = tTemp
End Sub

Gruß Uwe
Antworten Top
#8
Hallo Uwe,

leider bekomme ich den von Dir geschriebenen Code nicht zum laufen.
D.h. es gibt keine Ergebnisausgabe in das Tabellenblatt 4. Es passiert leider gar nichts.
Antworten Top
#9
Hallo,

die Tabellen(namen) in meinem Code sind die Codenamen,
die im VBA-Editor an erster Stelle stehen und nicht die
Registernamen, die im VBA-Editor in Klammern stehen.

Gruß Uwe
Antworten Top
#10
Hi Leute,

hier mein Lösungsvorschlag:
(Code-Verbesserungen ausdrücklich erwünscht! - Danke.)

Code:
Sub MischenZeilenweise()
Dim i As Long, z As Long, dblT As Variant, dum as Variant

'Anzahl der zu mischenden Zeilen:
zeilen = 65500
Dim varL As Variant
ReDim varL(zeilen)

For s = 1 To zeilen
varL(s) = Rows(s & ":" & s).Value
Next s

For i = zeilen To 1 Step -1
Randomize Timer
iZ = Int((i * Rnd) + 1)
dum = varL(iZ)
varL(iZ) = varL(i)
varL(i) = dum
Next i

'Übertragung der gemischten Zeilen in Tabellenblatt 2
For x = 1 To zeilen
Tabelle2.Rows(x & ":" & x).Value = varL(x)
Next x

End Sub
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste