Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1272to1276
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

welche Schleife ?

welche Schleife ?
Udo
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
AW: welche Schleife ?
21.08.2012 23:08:30
Gerd
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
AW: welche Schleife ?
21.08.2012 23:15:16
Franc
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

Anzeige
AW: welche Schleife ?
22.08.2012 08:32:28
Udo
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.
Userbild
Anzeige
AW: welche Schleife ?
22.08.2012 16:25:13
Franc
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?
AW: welche Schleife ?
22.08.2012 16:25:29
Franc
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?
Anzeige
AW: welche Schleife ?
22.08.2012 17:25:10
Udo
Userbild
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.
AW: welche Schleife ?
22.08.2012 17:32:07
Franc
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.
Anzeige
AW: welche Schleife ?
22.08.2012 18:06:47
Udo
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.
Anzeige
AW: welche Schleife ?
22.08.2012 18:31:05
Franc
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?
AW: welche Schleife ?
22.08.2012 19:51:58
Franc
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.
Anzeige
AW: welche Schleife ?
22.08.2012 19:53:04
Franc
warum postet der das manchmal doppelt? ... (neiun ich mach grundsätzlich NIE doppelklicks im Inet)
AW: welche Schleife ?
22.08.2012 20:22:02
Udo
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, _
Anzeige
AW: welche Schleife ?
22.08.2012 21:02:32
Franc
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

Anzeige
AW: welche Schleife ?
22.08.2012 21:16:04
Udo
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
Anzeige
AW: welche Schleife ?
22.08.2012 21:43:20
Franc
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)
AW: welche Schleife ?
22.08.2012 22:16:46
Udo
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
AW: welche Schleife ?
22.08.2012 22:22:41
Udo
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

AW: welche Schleife ?
23.08.2012 00:28:53
Franc
ö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

AW: welche Schleife ?
23.08.2012 00:39:58
Franc
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

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige