Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

welche Schleife ? | Herbers Excel-Forum


Betrifft: welche Schleife ? von: Udo F.
Geschrieben am: 21.08.2012 20:51:55

Hallo Ihr Lieben !

Ich hoffe ich finde jetzt die richtige Formulierung:

100 Makros hab ich selber fabriziert. Davon sind 3 mit jeweils 60 Spalten ( A - BH ) Die anderen haben nur 30 Spalten. Nun muss ich immer mit der Maus die verschiedenen Makros anklicken und manchmal passieren da Fehler, so dass ein Makro läuft, welches nur 30 Spalten hat. Brauch aber immer ein Makro mit 60 Spalten ( die ändern sich immer )

Ich bräuchte nun eine Schleife, wo der Code nur ausgeführt wird, wenn tatsächlich 60 Spalten mit Daten belegt sind. Sind nur 30 Spalten belegt, soll nichts passieren und das Datenblatt soll so bleiben wie es war.

Ist das for next ?

Würde mich sehr über Hinweise freuen

Gruss Udo

  

Betrifft: AW: welche Schleife ? von: Gerd L
Geschrieben am: 21.08.2012 23:08:30

Guten Abend, Udo!

Hui, 100 Makros. Falls Du von diesen exemplarische hier einstellen würdest, käme bestimmt ein Kürzungswunder heraus. :-)

Sub a()

'ermittelt im aktiven Blatt in Zeile 1 von rechts die Nummer der letzten Spalte mit Wert
If ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlToLeft).Column > 30 Then Exit Sub

'..............weiterer Code

End Sub

Gruß Gerd


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 21.08.2012 23:15:16

falls die Spalten nicht nebeneinander liegen dann für Zeile 1
Wie Gerd schon geschrieben hat stell ruhig all deine Makros + Mappe ein und das ganze wird sicher viel viel einfacher.

Sub Anzahl_befuellter_Spalten()

If Application.WorksheetFunction.Count(Rows(1)) = 60 Then
    'Aktion bei 60
ElseIf Application.WorksheetFunction.Count(Rows(1)) = 30 Then
    'Aktion bei 30
End If

End Sub



  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 08:32:28

Danke Euch für feedback. OK ich stell mal eines hier rein:

Sub Ro_12_R_13()
'
' 12+13 Makro
'

'
Workbooks.Open Filename:="G:\Roulette\Datenblätter\db12.csv"

    Windows("db12.csv").Activate
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    Workbooks.Open Filename:="G:\Roulette\Datenblätter\db13.csv"

    Windows("db13.csv").Activate
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    Windows("db13.csv").Activate
        Windows("db12.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul21.DreisigSpaltenSollstDuWaehlen"
    Selection.copy
    Windows("db13.csv").Activate
    Range("BH1").Select
    ActiveSheet.Paste
    Application.Run "PERSONAL.xlsb!einfuegen"
     Application.Run "PERSONAL.xlsb!spaltenvergleich"
    Windows("db12.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul3.löschen"
        Application.Run "PERSONAL.xlsb!format"
End Sub
.....

hier werden aus den 60 Spalten 30 zufällig ausgewählt und ( immer )in die leeren graden Spalten eingefügt. Also würde auch eine Abfrage reichen, ob z.b. die Zelle b1 leer ist.





  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 16:25:13

ok ... du öffnest also eine Datei und teilst die Werte aus Spalte A mit dem Semikolon als Trennzeichen auf die anderen Spalten auf. ist die Ursprungsspalte so aufgebaut?
Zahl;"";Zahl;"";zahl usw.?

Was für einen Sinn macht es aus 30 Spalten 30 auszuwählen oder darf eine Spalte öfter vorkommen?


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 16:25:29

ok ... du öffnest also eine Datei und teilst die Werte aus Spalte A mit dem Semikolon als Trennzeichen auf die anderen Spalten auf. ist die Ursprungsspalte so aufgebaut?
Zahl;"";Zahl;"";zahl usw.?

Was für einen Sinn macht es aus 30 Spalten 30 auszuwählen oder darf eine Spalte öfter vorkommen?


  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 17:25:10



Richtig, das macht keinen Sinn. 30 neue Spalten werden immer aus der Mappe entnommen , wo 60 Spalten drin sind.

Ich habe immer 3 Mappen wo 60 Spalten drin sind und 97 wo nur 30 Spalten drin sind. Wenn 30, dann soll das Makro nicht durchlaufen , immer nur dann wenn es 60 sind.


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 17:32:07

k ... aber hier sind keine leeren geraden Spalten.
Es sind 60 Spalten hintereinander. Was genau soll denn nun passieren?

Prob ist das ich die anderen Makros nicht sehe sonst könnt ich mir das noch zusammenreimen.
Wenn da nix ultrageheimes drin ist, dann ladt am besten die Mappe mit all den Makros hoch.


  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 18:06:47

geheim sind die nicht, nur sind es ziemlich viele.

Die Sache ist doch eigentlich einfach: Das Makro soll nur laufen wenn die Mappe über 60 Spalten hintereinander verfügt. Ich hab jpgs hochgeladen wo die Mappe mit den 60 und die mit den 30 vorhanden ist.

es werden dann aus den 60 Spalten zufällig 30 ausgewählt, diese kommen in die graden Leerräume der nächsten Mappe. So dass dann die nächste Mappe über 60 Spalten verfügt. Manchmal klick ich nun auf eine mappe wo nur 30 Spalten drin sind und dann ist Chaos und ich muss alle Mappen wieder neu aus der Sicherung nehmen.

Kann leider überhaupt nicht programmieren.

Es würde reichen, wenn der VBA Code feststellt, dass die Zelle B1 leer ist, dann soll das Makro nicht starten. Ist im Feld B1 eine Zahl , dann soll das Makro laufen.

Das gleiche gilt dann für D1 usf. Ist B1 leer , dann kann es sich nicht um eine Mappe handeln, die 60 Spalten umfasst und dann können daraus auch keine 30 Spalten zufällig entnommen werden.


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 18:31:05

ah k - das ist jetzt schon wesentlich klarer
nur noch eines
haben die Dateien immer die selbe Namensgebung also "db" + "zahl" + ".csv"?
bzw sind im ordner G:\Roulette\Datenblätter\ nur diese csv Dateien drin?


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 19:51:58

Dann quasi so wie anfangs beschrieben mit einer minimal Änderung.
Am Anfang vom Makro das einfügen.
Dann startet es nur wenn jeweils ein Wert enthalten ist.

If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub

das mit dem TexttoColumns sollte auch ohne das ganze array Zeug funktionieren
das ist denk ehj nur da wenn du verschiedene Datentypen hast

Sollte auch so klappen
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True

Wenn vielleicht doch mal alle hochladen willst, könnte man das sicher optimieren - je nachdem ob es aktuell zu lang dauert/du alle Dateien von hand öffnen mußt.


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 19:53:04

warum postet der das manchmal doppelt? ... (neiun ich mach grundsätzlich NIE doppelklicks im Inet)


  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 20:22:02

hm, in meinem Datenblatt 23 sind momentan 60 Spalten. Aber nachdem ich den Code eingefügt habe, wie von Dir geschrieben am Anfang des Makros, startet es nicht







Sub Ro_23_R_24()

'

' 23+24 Makro

'



'

If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub

Workbooks.Open Filename:="G:\Roulette\Datenblätter\db23.csv"



Windows("db23.csv").Activate







Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 21:02:32

steht in jeder der spalten etwas drin?
es kann auch sein das er im falschen Blatt nachschaut - ohne weitere Angabe schaut er nur im aktiven Blatt
ein weiterer Fehler wäre es, wenn du den Code im Tabellenblatt stehen hast - dann sucht er nur in diesem Tabellenblatt und ignoriert das was gerade aktiv ist
du müsstest den Code in ein Modul einfügen oder festlegen wo er schauen soll zum beispiel so

Application.WorksheetFunction.CountA(Workbooks("Name der Datei").Sheets(1).Range("A1:BH1"))


du kannst auch folgendes testen - hier zeigt er dir an wieviel befüllte Zellen es gibt

Sub test()

msgbox Application.WorksheetFunction.CountA(Range("A1:BH1"))

End Sub



  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 21:16:04

Hi Franc,

also Dein schöner Code darf nicht am Anfang des Makros stehen. Durch die csv Daten , gibts ja die ganzen array befehle, die meine Zahlen wieder schön ordentlich in die entsprechenden Zellen schreiben. Ansonsten stehen die leider nach dem speichern alle in A1 usf.

Schreibe ich nun den Code vor Begin des nächsten Datenblattes sehe ich dann, dass ich mich verklickt habe und im Blatt nur 30 Spalten sind. Ich kann dann ohne Probs abbrechen. Also ist mein Ziel erreicht :-)

vielen Dank dafür.

Die anderen makros stelle ich gerne nochmal hier rein. Vielleicht kann man wirklich hier kürzen.

PS dies alles hier ist in vielen Jahren entstanden, viele User hier im Forum haben mir hier bei den anderen Makros geholfen, die konnte ich dann so nach und nach alle einbauen :-)

Zu dumm, wenn man nicht selber programmieren kann.

Schönen Rest vom Abend noch


  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 22.08.2012 21:43:20

Ach das mit dem Programmieren geht eigentlich. Bin da auch nur Anfänger und es gibt dann sicher noch mal eine schönere/schnellere Lösung aber mir macht sowas Spaß.

Man kann aber fast alles automatisieren. Besonders gut geht das natürlich dann, wenn ein "System" dahintersteckt was sich wiederholt. Dann muss man nicht für alles einen separaten Code schreiben sondern braucht nur noch ein Makro das alles erledigt.

In deinem Fall könnte das so aussehen (schemenhaft) Hängt natürlich auch davon ab wie oft es vorkommt das nur 30 Spalten da sind. Am einfachsten wäre es natürlich wenn es eine Ausnahme bleibt.

Also - ist nur sinnbildlich ohne code ^^

für alle Dateien cb**.csv im Verzeichnis x (for to next schleife)

texttocolums
prüfung wieviel spalten es hat
wenn es sehr oft vorkommt das nur 30 spalten da sind, dann könnte man 2 "Listen/arrays" erstellen
wenn 30 dann array30(name hinzufügen)
wenn 60 dann array30(name hinzufügen)

ende der for to next schleife um alle dateien mit texttocolums durchzugehen und entsprechend der spaltenanzahl in den arrays auflisten

danach im selben makro öffnet man entweder noch mal der reihe nach alle dateien mit 30 spalten und jeweils eine mit 60 um dort 30 zu entnehmen
oder man läßt je nach anzahl direkt alle Dateien auf und erledigt alles und schließt danach alle dateien die geöffnet wurden


Dazu bräuchte man aber alle verschiedenen makros die du verwendest und eben die Info ob alle Dateien in einem Verzeichnis liegen und wie viele es sind und ob es immer entweder 30 oder 60 Spalten sind. (die genaue Anzahl der Dateien ist in dem Fall egal, weil das ganze variabel ist)


  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 22:16:46

Es sind immer genau 60 oder 30. Ich habe 3 Programme, da laufen die Datenblätter paralel. Also brauch ich immer 3 Mappen, wo 60 Spalten drin sind, weil die Programme diese 60 Spalten abarbeiten. In einer Mappe sind immer 60*8000= 480.000 Zufallszahlen drin ( von Hand ermittelt, also kein Zufallsgenerator ! )

Ist ein Programm fertig, dann werden wieder neue 60 neue Spalten generiert.

dies ist das Makro 1

Sub Ro_26_R_27()
'
' 26+27 Makro
'

'

Workbooks.Open Filename:="G:\Roulette\Datenblätter\db26.csv"
    Windows("db26.csv").Activate
    

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub
    
    'Ende blatt 26
    
    Workbooks.Open Filename:="G:\Roulette\Datenblätter\db27.csv"

    Windows("db27.csv").Activate
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    Windows("db27.csv").Activate
        Windows("db26.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul21.DreisigSpaltenSollstDuWaehlen"
    Selection.copy
    Windows("db27.csv").Activate
    Range("BH1").Select
    ActiveSheet.Paste
    Application.Run "PERSONAL.xlsb!einfuegen"
     Application.Run "PERSONAL.xlsb!spaltenvergleich"
    Windows("db26.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul3.löschen"
        Application.Run "PERSONAL.xlsb!format"
End Sub
Sub Ro_27_R_28()
'
' 26+27 Makro
'

'
Workbooks.Open Filename:="G:\Roulette\Datenblätter\db27.csv"


    Windows("db27.csv").Activate

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub
    
    'Ende blatt 27
    
    Workbooks.Open Filename:="G:\Roulette\Datenblätter\db28.csv"

    Windows("db28.csv").Activate
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1)), TrailingMinusNumbers:=True
        
        
        
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),  _
Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, _
 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1),  _
Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39,  _
1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1),  _
Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52,  _
1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1),  _
Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65,  _
1), _
        Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1),  _
Array( _
        72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78,  _
1), _
        Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1),  _
Array( _
        85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1)), TrailingMinusNumbers _
        :=True
    Application.Run "PERSONAL.xlsb!format"
    
    Windows("db28.csv").Activate
        Windows("db27.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul21.DreisigSpaltenSollstDuWaehlen"
    Selection.copy
    Windows("db28.csv").Activate
    Range("BH1").Select
    ActiveSheet.Paste
    Application.Run "PERSONAL.xlsb!einfuegen"
     Application.Run "PERSONAL.xlsb!spaltenvergleich"
    Windows("db27.csv").Activate
    Application.Run "PERSONAL.xlsb!Modul3.löschen"
        Application.Run "PERSONAL.xlsb!format"
End Sub

dies ist das "Format Makro
Sub format()
'
' format Makro
' Makro am 10.04.2008 von darlee aufgezeichnet
'
' Tastenkombination: Strg+f
'
    Cells.Select
    Selection.Columns.AutoFit
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.ColumnWidth = 2.86
    Range("A1").Select
End Sub
dies hier das Makro welches 30 Spalten aus den 60 auswählt.
Sub DreisigSpaltenSollstDuWaehlen()
Dim varColumns() As Integer
Dim intIndex As Integer, intRnd As Integer
Dim rngCol As Range

'Array dimensionieren
ReDim varColumns(58)

'Array mit den Zahlen von 2 bis 60 füllen
For intIndex = 0 To UBound(varColumns)
  varColumns(intIndex) = intIndex + 2
Next

'Zufallsgeneratot 'anstossen!
Randomize

For intIndex = 1 To 30
  
  'Zufällig eine Zahl zwischen 0 und Obergrenze des Arrays wählen
  intRnd = Int(Rnd() * UBound(varColumns))
  
  'Die Zufällig gewählte Spalte der Range-Variablen zuwisen
  If rngCol Is Nothing Then
    Set rngCol = Columns(varColumns(intRnd))
  Else
    Set rngCol = Union(rngCol, Columns(varColumns(intRnd)))
  End If
  
  'Das letzte Element des Arrays in die eben gewählte Position schreiben
  'und das Array um das letzte Element kürzen. (damit keine Zahl doppelt gewählt wird!)
  varColumns(intRnd) = varColumns(UBound(varColumns))
  ReDim Preserve varColumns(UBound(varColumns) - 1)
  
Next

'Ausgewählte Spalten markieren
rngCol.Select

End Sub

dies hier fügt die ausgewählten 30 Spalten in die freien Spalten ein
Sub einfuegen()
    Application.ScreenUpdating = False
    Columns("BI:BI").Cut Destination:=Range("AF1")
    Columns("BK:BK").Cut Destination:=Range("AD1")
    Columns("BL:BL").Cut Destination:=Range("AH1")
    Columns("BJ:BJ").Cut Destination:=Range("AB1")
    Columns("CK:CK").Cut Destination:=Range("AJ1")
    Columns("CJ:CJ").Cut Destination:=Range("BF1")
    Columns("CI:CI").Cut Destination:=Range("BD1")
    Columns("CH:CH").Cut Destination:=Range("BB1")
    Columns("CG:CG").Cut Destination:=Range("AZ1")
    Columns("CF:CF").Cut Destination:=Range("AX1")
    Columns("CE:CE").Cut Destination:=Range("AV1")
    Columns("CD:CD").Cut Destination:=Range("AT1")
    Columns("CC:CC").Cut Destination:=Range("AR1")
    Columns("CB:CB").Cut Destination:=Range("AP1")
    Columns("CA:CA").Cut Destination:=Range("AN1")
    Columns("BZ:BZ").Cut Destination:=Range("AL1")
    Columns("BY:BY").Cut Destination:=Range("Z1")
    Columns("BX:BX").Cut Destination:=Range("X1")
    Columns("BW:BW").Cut Destination:=Range("V1")
    Columns("BV:BV").Cut Destination:=Range("T1")
    Columns("BU:BU").Cut Destination:=Range("R1")
    Columns("BT:BT").Cut Destination:=Range("P1")
    Columns("BS:BS").Cut Destination:=Range("N1")
    Columns("BR:BR").Cut Destination:=Range("L1")
    Columns("BM:BM").Cut Destination:=Range("J1")
    Columns("BQ:BQ").Cut Destination:=Range("H1")
    Columns("BP:BP").Cut Destination:=Range("F1")
    Columns("BO:BO").Cut Destination:=Range("D1")
    Columns("BN:BN").Cut Destination:=Range("B1")
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub
Um Fehler zu vermeiden , doppelte gleiche Spalten wären schlecht, kommt das hier zum Einsatz
Sub SpaltenVergleich()
  Dim Spalte1 As Long, Spalte2 As Long, Spalten As Long
  Dim Zeile1 As Long, Zeile2 As Long
  
  Zeile1 = 1
  Zeile2 = 100
  Spalten = 60
  Application.Calculation = xlCalculationManual
  With Cells(1, Spalten + 1)
    For Spalte1 = 1 To Spalten - 1
      For Spalte2 = Spalte1 + 1 To Spalten
          .FormulaR1C1 = "=SUMPRODUCT((R" & Zeile1 & "C" & Spalte1 _
          & ":R" & Zeile2 & "C" & Spalte1 & "<> R" & Zeile1 & "C" & Spalte2 & ":R" _
          & Zeile2 & "C" & Spalte2 & ")*1)"
          .Calculate
          If .Value = 0 Then
            If MsgBox("Spalte " & Spalte1 & " und " & Spalte2 & " sind identisch", _
                vbInformation + vbRetryCancel, "Spaltenvergleich") = vbCancel Then GoTo Beenden
          End If
      Next
    Next
Beenden:
    .ClearContents
  End With
  Application.Calculation = xlCalculationAutomatic
End Sub
Zum guten Schluss, soll der mir die ausgewählten 30 Spalten löschen, weil diese ja dann in der neuen Mappe sind und aus der alten raus müssen
Sub spielblatt_loeschen()
'
' spielblatt_loeschen Makro
' löscht die falschen Einträge pair impair
'

'
    Range("J4").Select
    Selection.ClearContents
    Range("K6").Select
    Selection.ClearContents
    Range("J4:K4").Select
    Selection.ClearContents
    Range("J6:K6").Select
    Selection.ClearContents
    Range("J8:K8").Select
    Selection.ClearContents
    Range("J10:K10").Select
    Selection.ClearContents
    Range("J12:K12").Select
    Selection.ClearContents
    Range("J14:K14").Select
    Selection.ClearContents
    Range("J16:K16").Select
    Selection.ClearContents
    Range("J18:K18").Select
    Selection.ClearContents
    Range("J20:K20").Select
    Selection.ClearContents
    Range("J22:K22").Select
    Selection.ClearContents
    Range("J24:K24").Select
    Selection.ClearContents
    Range("J26:K26").Select
    Selection.ClearContents
    Range("J28:K28").Select
    Selection.ClearContents
    Range("J30:K30").Select
    Selection.ClearContents
    Range("J32:K32").Select
    Selection.ClearContents
    Range("J34:K34").Select
    Selection.ClearContents
    Range("J36:K36").Select
    Selection.ClearContents
    Range("J38:K38").Select
    Selection.ClearContents
    Range("J40:K40").Select
    Selection.ClearContents
    Range("J42:K42").Select
    Selection.ClearContents
    Range("J44:K44").Select
    Selection.ClearContents
    Range("J46:K46").Select
    Selection.ClearContents
    Range("J48:K48").Select
    Selection.ClearContents
    Range("J50:K50").Select
    Selection.ClearContents
    Range("J52:K52").Select
    Selection.ClearContents
    Range("J54:K54").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=27
    Range("J56:K56").Select
    Selection.ClearContents
    Range("J58:K58").Select
    Selection.ClearContents
    Range("J60:K60").Select
    Selection.ClearContents
    Range("J62:K62").Select
    Selection.ClearContents
    Range("J64:K64").Select
    Selection.ClearContents
    Range("J66:K66").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-154
    Range("P3:Q3").Select
    Selection.ClearContents
    Range("P5:Q5").Select
    Selection.ClearContents
    Range("P7:Q7").Select
    Selection.ClearContents
    Range("P9:Q9").Select
    Selection.ClearContents
    Range("P11:Q11").Select
    Selection.ClearContents
    Range("P13:Q13").Select
    Selection.ClearContents
    Range("P15:Q15").Select
    Selection.ClearContents
    Range("P17:Q17").Select
    Selection.ClearContents
    Range("P19:Q19").Select
    Selection.ClearContents
    Range("P21:Q21").Select
    Selection.ClearContents
    Range("P23:Q23").Select
    Selection.ClearContents
    Range("P25:Q25").Select
    Selection.ClearContents
    Range("P27:Q27").Select
    Selection.ClearContents
    Range("P29:Q29").Select
    Selection.ClearContents
    Range("P31:Q31").Select
    Selection.ClearContents
    Range("P33:Q33").Select
    Selection.ClearContents
    Range("P35:Q35").Select
    Selection.ClearContents
    Range("P37:Q37").Select
    Selection.ClearContents
    Range("P39:Q39").Select
    Selection.ClearContents
    Range("P41:Q41").Select
    Selection.ClearContents
    Range("P43:Q43").Select
    Selection.ClearContents
    Range("P45:Q45").Select
    Selection.ClearContents
    Range("P47:Q47").Select
    Selection.ClearContents
    Range("P49:Q49").Select
    Selection.ClearContents
    Range("P51:Q51").Select
    Selection.ClearContents
    Range("P53:Q53").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=39
    Range("P55:Q55").Select
    Selection.ClearContents
    Range("P57:Q57").Select
    Selection.ClearContents
    Range("P59:Q59").Select
    Selection.ClearContents
    Range("P61:Q61").Select
    Selection.ClearContents
    Range("P63:Q63").Select
    Selection.ClearContents
    Range("P65:Q65").Select
    Selection.ClearContents
End Sub
Auf diese Art und Weise hab ich immer "neue" 480.000 Zufallszahlen , die sich nie wiederholen können, dafür lebe ich nicht lange genug :-)

übrigens funzt das auf excel 2010 mit 64 bit gar nicht gut. Es dauert länger als 15 sec, nachdem das Makro abgearbeitet ist. Der ganze PC ist blockiert. ( Hab nen Phenon Prozessor 3,2 GHZ vier Kerne) Und die Ausführung des Makros dauert auch ewig. Deswegen hab ich excel 2010 wieder deinstalliert und arbeite wieder mit excel 2007.

Gruss Udo


  

Betrifft: AW: welche Schleife ? von: Udo F.
Geschrieben am: 22.08.2012 22:22:41

Ist mir ein Fehler unterlaufen, das löschen Makro ist dieses

Sub löschen()
'
' löschen Makro
' Makro am 10.04.2008 von darlee aufgezeichnet
'
' Tastenkombination: Strg+l
'
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
'
' spalten_leeraeume_einfuegen Makro
' Makro am 11.04.2008 von darlee aufgezeichnet
'

'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Columns("T:T").Select
    Selection.Insert Shift:=xlToRight
    Columns("V:V").Select
    Selection.Insert Shift:=xlToRight
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight
    Columns("AD:AD").Select
    Selection.Insert Shift:=xlToRight
    Columns("AF:AF").Select
    Selection.Insert Shift:=xlToRight
    Columns("AH:AH").Select
    Selection.Insert Shift:=xlToRight
    Columns("AJ:AJ").Select
    Selection.Insert Shift:=xlToRight
    Columns("AL:AL").Select
    Selection.Insert Shift:=xlToRight
    Columns("AN:AN").Select
    Selection.Insert Shift:=xlToRight
    Columns("AP:AP").Select
    Selection.Insert Shift:=xlToRight
    Columns("AR:AR").Select
    Selection.Insert Shift:=xlToRight
    Columns("AT:AT").Select
    Selection.Insert Shift:=xlToRight
    ActiveWindow.SmallScroll ToRight:=15
    Columns("AV:AV").Select
    Selection.Insert Shift:=xlToRight
    Columns("AX:AX").Select
    Selection.Insert Shift:=xlToRight
    Columns("AZ:AZ").Select
    Selection.Insert Shift:=xlToRight
    Columns("BB:BB").Select
    Selection.Insert Shift:=xlToRight
    Columns("BD:BD").Select
    Selection.Insert Shift:=xlToRight
    Columns("BF:BF").Select
    Selection.Insert Shift:=xlToRight


    Range("A1").Select
End Sub



  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 23.08.2012 00:28:53

öhm ja .. denk da kann man nicht all zu viel optimieren. Evtll mit den Originaldateien wie sie vor dem Makro ausführen aussehen.

evtll als zip packen und mir senden? ich stell sie natürlich nicht online
franc.klepec@email.de

ansonsten habe ich das Makro erstmal gekürzt (von 24 Seiten auf 8 Seiten) und sollte so laufen wie bisher (hab paar kleine Dinge abgeändert aber sollte keine fehler geben
beim einfügen makro hattest du eine leicht andere Reihenfolge in der mitte aber das kam evtll nur vom manuellen kopieren/aufzeichnen

da das ganze aber blind ohne testen erfolgt ist, solltest du vor dem probieren Sicherheitskopien anfertigen

das mit den Sicherheitskopien gelesen? gut ^^

wirklich gelesen? - k, hör ja schon auf - sicher ist sicher ;-)

Sub Ro_26_R_27()
'
' 26+27 Makro
'
Workbooks.Open Filename:="G:\Roulette\Datenblätter\db26.csv"
Windows("db26.csv").Activate

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, Semicolon:=True, TrailingMinusNumbers:=True

If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub

Application.Run "PERSONAL.xlsb!format"
'Ende blatt 26
    
Workbooks.Open Filename:="G:\Roulette\Datenblätter\db27.csv"
Windows("db27.csv").Activate

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, Semicolon:=True, TrailingMinusNumbers:=True

Application.Run "PERSONAL.xlsb!format"
Windows("db26.csv").Activate
    
Application.Run "PERSONAL.xlsb!Modul21.DreisigSpaltenSollstDuWaehlen"
    
Selection.Copy
Windows("db27.csv").Activate
Range("BH1").Select
ActiveSheet.Paste
Application.Run "PERSONAL.xlsb!einfuegen"
Application.Run "PERSONAL.xlsb!spaltenvergleich"
Windows("db26.csv").Activate
Application.Run "PERSONAL.xlsb!Modul3.löschen"
Application.Run "PERSONAL.xlsb!format"

End Sub
Sub Ro_27_R_28()
'
' 26+27 Makro
'

Workbooks.Open Filename:="G:\Roulette\Datenblätter\db27.csv"
Windows("db27.csv").Activate

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, Semicolon:=True, TrailingMinusNumbers:=True
        
If Application.WorksheetFunction.CountA(Range("A1:BH1")) <> 60 Then Exit Sub
Application.Run "PERSONAL.xlsb!format"
'Ende blatt 27

Workbooks.Open Filename:="G:\Roulette\Datenblätter\db28.csv"
Windows("db28.csv").Activate

Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, Semicolon:=True, TrailingMinusNumbers:=True
    
Application.Run "PERSONAL.xlsb!format"
Windows("db27.csv").Activate

Application.Run "PERSONAL.xlsb!Modul21.DreisigSpaltenSollstDuWaehlen"
Selection.Copy
Windows("db28.csv").Activate
Range("BH1").Select
ActiveSheet.Paste
Application.Run "PERSONAL.xlsb!einfuegen"
Application.Run "PERSONAL.xlsb!spaltenvergleich"
Windows("db27.csv").Activate
Application.Run "PERSONAL.xlsb!Modul3.löschen"
Application.Run "PERSONAL.xlsb!format"

End Sub

Sub format()
'
' format Makro
' Makro am 10.04.2008 von darlee aufgezeichnet
'
' Tastenkombination: Strg+f
'
Cells.Select
Selection.Columns.AutoFit
With Selection.Font
    .Name = "Arial"
    .Size = 8
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
End With

Selection.ColumnWidth = 2.86
Range("A1").Select

End Sub

Sub DreisigSpaltenSollstDuWaehlen()

Dim varColumns() As Integer
Dim intIndex As Integer, intRnd As Integer
Dim rngCol As Range

'Array dimensionieren
ReDim varColumns(58)

'Array mit den Zahlen von 2 bis 60 füllen
For intIndex = 0 To UBound(varColumns)
  varColumns(intIndex) = intIndex + 2
Next

'Zufallsgeneratot 'anstossen!
Randomize

For intIndex = 1 To 30
 
    'Zufällig eine Zahl zwischen 0 und Obergrenze des Arrays wählen
    intRnd = Int(Rnd() * UBound(varColumns))
    
    'Die Zufällig gewählte Spalte der Range-Variablen zuwisen
    If rngCol Is Nothing Then
        Set rngCol = Columns(varColumns(intRnd))
    Else
        Set rngCol = Union(rngCol, Columns(varColumns(intRnd)))
    End If
  
    'Das letzte Element des Arrays in die eben gewählte Position schreiben
    'und das Array um das letzte Element kürzen. (damit keine Zahl doppelt gewählt wird!)
    varColumns(intRnd) = varColumns(UBound(varColumns))
    ReDim Preserve varColumns(UBound(varColumns) - 1)

Next

'Ausgewählte Spalten markieren
rngCol.Select

End Sub

Sub einfuegen()

Dim i As Integer, z As Integer

Application.ScreenUpdating = False

For i = 61 To 89
    z = z + 2
    Columns(i).Cut Destination:=Columns(z)
Next
'ActiveWorkbook.Save
Application.ScreenUpdating = True

End Sub

Sub SpaltenVergleich()
Dim Spalte1 As Long, Spalte2 As Long, Spalten As Long
Dim Zeile1 As Long, Zeile2 As Long

Zeile1 = 1
Zeile2 = 100
Spalten = 60
Application.Calculation = xlCalculationManual
With Cells(1, Spalten + 1)
    For Spalte1 = 1 To Spalten - 1
        For Spalte2 = Spalte1 + 1 To Spalten
            .FormulaR1C1 = "=SUMPRODUCT((R" & Zeile1 & "C" & Spalte1 _
                & ":R" & Zeile2 & "C" & Spalte1 & "<> R" & Zeile1 & "C" & Spalte2 & ":R" _
                & Zeile2 & "C" & Spalte2 & ")*1)"
            .Calculate
            If .Value = 0 Then
                If MsgBox("Spalte " & Spalte1 & " und " & Spalte2 & " sind identisch", _
                    vbInformation + vbRetryCancel, "Spaltenvergleich") = vbCancel Then GoTo  _
Beenden
            End If
        Next
    Next
Beenden:
    .ClearContents
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Sub spielblatt_loeschen()
'
' spielblatt_loeschen Makro
' löscht die falschen Einträge pair impair

Dim i As Integer

For i = 4 To 66 Step 2
    Range("J" & i, "k" & i).ClearContents
    Range("P" & i - 1, "Q" & i - 1).ClearContents
Next i

End Sub

Sub löschen()

'Tastenkombination: Strg l

Application.ScreenUpdating = False

'wozu ist das gut? kann man sicher weglassen
Selection.Delete Shift:=xlToLeft

' spalten_leeraeume_einfuegen Makro
For i = 2 To 118 Step 2
    Columns(i).Insert Shift:=xlToRight
Next

Range("A1").Select
Application.ScreenUpdating = True

End Sub



  

Betrifft: AW: welche Schleife ? von: Franc
Geschrieben am: 23.08.2012 00:39:58

beim löschenn makro hab ich grad doch noch nen kleinen fehler gesehen ^^

Du hast ursprünglich 30 Spalten direkt nebeneinander und willst nach jeder 2. eine einfügen um dann wiederum die Zufallspalten reinzukopieren oder?
mit den 118 würden doppelt so viele Spalten eingefügt wie sein soll. hab das auf 58 geändert

Sub löschen()

'Tastenkombination: Strg l

Application.ScreenUpdating = False

'wozu ist das gut? kann man sicher weglassen
Selection.Delete Shift:=xlToLeft

' spalten_leeraeume_einfuegen Makro
For i = 2 To 58 Step 2
    Columns(i).Insert Shift:=xlToRight
Next

Range("A1").Select
Application.ScreenUpdating = True

End Sub



Beiträge aus den Excel-Beispielen zum Thema "welche Schleife ?"