PDA

Vollständige Version anzeigen : Zufällige Zeilen kopieren mit Restriktion


Joghivan
21.02.2008, 08:26
Hallo zusammen,

ich benötige erneut Hilfe in VBA. Ich beabsichtige in eine Matrix A (Tabelle1) mit 13 Spalten zufällige Einträge aus einer anderen Matrix B (Tabelle2) mit 13 Spalten zu kopieren.
Es soll nicht die ganze Zeile sondern nur die zusammenhängen Einträge der ersten 13 Spalten kopiert werden. Die Mehrfachauswahl einer Zeile in Matrix B ist zulässig, es müssen sich also keine bereits ausgewählten Zeilen gemerkt werden.

Als Restriktion sollen in Matrix A nur diejenigen Zeilen überschrieben werden, die in Spalte 14 mit "nein" gekennzeichnet sind. Der Algorithmus sollte möglichst wenig Rechenzeit benötigen, da die Anzahl der Zeilen recht hoch ist.

Folgender Code ist bislang implementiert. Er ist aber recht rechenintensiv und prüft nicht den Eintrag in Spalte 14 (ja/nein) ab. Dadurch, dass nur die Einträge in den Zeilen mit "nein" überschrieben werden sollen, lässt sich sicher Rechenzeit sparen.

Dim Field(), i, j, Mem, AnzahlZeilenA, AnzahlZeilenB
AnzahlZeilenA = 1000 ' Länge der Matrix A
AnzahlZeilenB = 500 ' Länge der Matrix B
Field = Range("A1:N1001")
Sheets("Tabelle2").Select
For i = 1 To AnzahlZeilenA
Mem = Int(Rnd() * AnzahlZeilenB + 1)
For j = 1 To 13
Field(i, j) = Cells(Mem, Chr(64 + j)).Value
Next
Next
Sheets("Tabelle1").Select
[A1:M1001] = Field()

Vielen Dank für die Unterstützung und Gruß
Joghivan

R J
24.02.2008, 15:51
Hi JogHivan,

nur mal kurz 'drübergeschaut, ohne den Sinn Deines Codes zu kontrollieren. Wenn Zeile 14 auf 'nein' geprüft werden soll, dann füge die If-Bedingung mit ein (sh. Bsp.)
For i = 1 To AnzahlZeilenA
Mem = Int(Rnd() * AnzahlZeilenB + 1)
If lcase(range("N" & i)) = "nein" then
For j = 1 To 13
Field(i, j) = Cells(Mem, Chr(64 + j)).Value
Next
endif
Next

Um die Sache zu beschleunigen solltest Du statt
For i = 1 to...

besser mit For Each arbeiten.

Bsp.:
Dim Zelle

For each zelle in Range("A1:N1000")
'...Deine Anweisungen
next

Hinweis:
For Each arbeitet zunächst die angegebenen Spalten (zeilenweise) von links nach rechts uind dann die Zeilen von oben nach unten ab. Bsp.:

Bereich A1:B2

Abarbeitung: A1, A2, B1, B2

ransi
24.02.2008, 16:44
HAllo

Ich hoffe ich habs richtig verstanden:
Der Einfachheit halber:
Tabelle1!A1:M2000 sind Daten.
Tabelle1!N1:N2000 steht "nein" oder etwas anderes.

Tabelle2!A1:M2000 sind auch Daten.
Teste mal diesen Code:

<nobr><span style="font-family:Courier New,Arial; font-size:9pt ;" ><span style="color:#000080"; >Option</span> <span style="color:#000080"; >Explicit</span><br /><br /><br /><b><span style="color:#000080"; >Public</span> <span style="color:#000080"; >Sub</span> test()</b><br /><span style="color:#000080"; >Dim</span> Tab1(1 <span style="color:#000080"; >To</span> 2000)<br /><span style="color:#000080"; >Dim</span> Tab2(1 <span style="color:#000080"; >To</span> 2000)<br /><span style="color:#000080"; >Dim</span> Arr<br /><span style="color:#000080"; >Dim</span> Z <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br /><span style="color:#000080"; >Dim</span> L <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br />Arr = Sheets(<span style="color:#800000"; >"Tabelle1"</span>).Range(<span style="color:#800000"; >"N1:N2000"</span>)<br />Randomize Timer<br /><span style="color:#008000"; >'2 Arrays f&uuml;llen</span><br /><span style="color:#000080"; >For</span> L = 1 <span style="color:#000080"; >To</span> 2000<br />&nbsp;&nbsp;&nbsp;&nbsp;Tab1(L) = Sheets(<span style="color:#800000"; >"Tabelle1"</span>).Range(<span style="color:#800000"; >"A1:M2000"</span>).Rows(L)<br /><span style="color:#000080"; >Next</span><br /><span style="color:#000080"; >For</span> L = 1 <span style="color:#000080"; >To</span> 2000<br />&nbsp;&nbsp;&nbsp;&nbsp;Tab2(L) = Sheets(<span style="color:#800000"; >"Tabelle2"</span>).Range(<span style="color:#800000"; >"A1:M2000"</span>).Rows(L)<br /><span style="color:#000080"; >Next</span><br /><span style="color:#008000"; >'Check auf "nein"</span><br /><span style="color:#000080"; >For</span> L = 1 <span style="color:#000080"; >To</span> 2000<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >If</span> Arr(L, 1) = <span style="color:#800000"; >"nein"</span> <span style="color:#000080"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Z = Int(2000 * Rnd + 1)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Tab1(L) = Tab2(Z)<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >End</span> <span style="color:#000080"; >If</span><br /><span style="color:#000080"; >Next</span><br /><span style="color:#008000"; >'Zur&uuml;ckschreiben</span><br /><span style="color:#000080"; >For</span> L = 1 <span style="color:#000080"; >To</span> 2000<br />&nbsp;&nbsp;&nbsp;&nbsp;Sheets(<span style="color:#800000"; >"Tabelle1"</span>).Range(<span style="color:#800000"; >"A1:M2000"</span>).Rows(L).Value = Tab1(L)<br /><span style="color:#000080"; >Next</span><br /><b><span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span></b><br /></span></nobr>

Wenn du das Ganze Dynamisch haben möchtest, musst du die Grenzen der Arrays mit Ubound() abfragen und die Zähler daruaf anpassen.

ransi

Joghivan
25.02.2008, 11:18
Zunächst vielen Dank zusammen. Die zweite Lösung ist leider auch recht rechenintensiv, sodass ich bei der ersten bleiben möchte. Der "For each"-Gedanke ist interessant, da dadurch auch die innere For-Schleife wegfallen kann.

Ich weiß nun aber nicht, wie ich den Ausdruck
Field(i, j) = Cells(Mem, Chr(64 + j)).Value
in der For-Each-Schleife umsetzen muss.
i und j sind ja die Laufvariablen der nun weggefallenen Schleifen.

Vielen Dank für weitere Anregungen.

R J
25.02.2008, 15:07
Hi,

Field(i,j) entspricht Zelle.address

ransi
25.02.2008, 15:26
HAllo Jogi

Das Ganze mal erweitert auf je 10000 DAtensätze.
Dauer ca. 5,2 sekunden.

<nobr><span style="font-family:Courier New,Arial; font-size:9pt ;" ><span style="color:#008000"; >' **********************************************************************</span><br /><span style="color:#008000"; >' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)</span><br /><span style="color:#008000"; >' **********************************************************************</span><br /><br /><span style="color:#000080"; >Option</span> <span style="color:#000080"; >Explicit</span><br /><br /><br /><b><span style="color:#000080"; >Public</span> <span style="color:#000080"; >Sub</span> test()</b><br /><span style="color:#000080"; >Dim</span> Tab1<br /><span style="color:#000080"; >Dim</span> Tab2<br /><span style="color:#000080"; >Dim</span> Z <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br /><span style="color:#000080"; >Dim</span> L <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br /><span style="color:#000080"; >Dim</span> S <span style="color:#000080"; >As</span> <span style="color:#000080"; >Double</span><br /><span style="color:#000080"; >Dim</span> B <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br />S = Timer<br />Randomize Timer<br /><span style="color:#008000"; >'2 Arrays f&uuml;llen</span><br />Tab1 = Sheets(<span style="color:#800000"; >"Tabelle1"</span>).Range(<span style="color:#800000"; >"A1:N10000"</span>)<br />Tab2 = Sheets(<span style="color:#800000"; >"Tabelle2"</span>).Range(<span style="color:#800000"; >"A1:M10000"</span>)<br /><span style="color:#008000"; >'Check auf "nein"</span><br /><span style="color:#000080"; >For</span> L = 1 <span style="color:#000080"; >To</span> 10000<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >If</span> Tab1(L, 14) = <span style="color:#800000"; >"Nein"</span> <span style="color:#000080"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Z = Int(10000 * Rnd + 1)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >For</span> B = 1 <span style="color:#000080"; >To</span> 13<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Tab1(L, B) = Tab2(Z, B)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Next</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >End</span> <span style="color:#000080"; >If</span><br /><span style="color:#000080"; >Next</span><br />fehler:<br /><span style="color:#008000"; >'Zur&uuml;ckschreiben</span><br />Sheets(<span style="color:#800000"; >"Tabelle1"</span>).Range(<span style="color:#800000"; >"A1:M10000"</span>).Value = Tab1<br />MsgBox Timer - S<br /><b><span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span></b><br /></span></nobr>

Wenn du eine Lösung mit
For Each zelle
hast die schneller ist, bin ich daran auch hochinteressiert.

ransi

Joghivan
26.02.2008, 11:58
Vielen Dank für die Ideen. Ich werde es auf der Suche nach der kürzesten Rechenzeit weiter versuchen...

Gruß
Joghivan