Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


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.
to 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-2016)
to top
#3
Hallo André,
interessante Idee die du da vorstellst. Aber leider
läuft der Code noch nicht.
to 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-2016)
to 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.)
to 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-2016)
to 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
to 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.
to 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
to 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
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Alle 6 Felder links von hier gucken, ob etwas drinsteht o0Julia0o 12 456 09.07.2016, 09:46
Letzter Beitrag: Luffy
  Unterschied von eindimensionalen Felder Annegret 2 228 24.05.2016, 14:33
Letzter Beitrag: Castor
  Eigabezwang für Felder hbboy15 3 278 10.05.2016, 19:02
Letzter Beitrag: schauan
  Text in einzelne Felder kopieren jann0r69 2 384 12.12.2015, 06:46
Letzter Beitrag: schauan
Information Zusammenführung verschiedener Felder zu einer Summary, ggf. sverweis mefra 5 543 29.11.2015, 19:31
Letzter Beitrag: schauan
  Zahlenformat für Felder bei Abfragen voyou 6 1.134 25.09.2015, 11:37
Letzter Beitrag: steve1da
  Mehrfachdruck eines Tabellenblattes Kieldiver 0 7.052 05.09.2015, 18:27
Letzter Beitrag: Kieldiver
  Leerstehende Felder bei Datum nicht beachten Benjamin 9 1.142 25.08.2015, 15:03
Letzter Beitrag: schauan
  Verbund dreier Felder peter70pag 3 586 13.11.2014, 14:42
Letzter Beitrag: peter70pag
  Stundenzahl berechnen nur, wenn Felder leer sind Asura 2 740 07.11.2014, 21:14
Letzter Beitrag: WillWissen

Gehe zu:


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