AW: MAKRO erweitern !?
01.11.2006 16:47:58
Leo
Hier ist das Quellcodeverzeichnis !!!!
Ich komme allerdings trotzdem nicht klar - wo kommt das rein ...
- - - - -
Option Explicit
Dim aVar(20000) ' ein Array mit 20.001 Plätzen, 0 - 20.000
'
' Es gibt Daten in den Zeilen 1 bis 20.000 - ebenso wie in den Spalten A bis H.
'
' Nun sollen die Daten aus der Zeile/Spalte 20000A, 20000B, 20000C, 20000D,
' 20000E, 20000F, 20000G, 20000H in die Zeilen/Spalten 1A, 1B, 1C, 1D, 1E,
' 1F, 1G, 1H getauscht werden
' und die Daten 199999A, 199999B, 199999C, 199999D, 19999E, 19999F, 19999G,
' 19999H in die Zeilen/Spalten 2A, 2B, 2C, 2D, 2E, 2F, 2G, 2H etc.
'
Sub Vertauschen()
Dim iSpalte As Integer ' For/Next Spaltenindex A - H
Dim lIndx As Long ' Index zum bearbeiten des Arrays
Dim lZeile As Long ' For/Next Zeilenindex 1 - 20.000
Application.ScreenUpdating = False ' Bildschirm Update unterbinden
For iSpalte = 1 To 8 ' Spalte A bis H
lIndx = 0 ' Array-Index auf 0 setzen
For lZeile = 20000 To 1 Step -1 ' von Zeile 20.000 bis 1
aVar(lIndx) = Cells(lZeile, iSpalte) ' Array mit Daten einer Spalte füllen
lIndx = lIndx + 1 ' Index um 1 erhöhen
Next lZeile ' nächste Zeile abwärts
For lZeile = 1 To 20000 ' von Zeile 1 bis 20.000
Cells(lZeile, iSpalte) = aVar(lZeile - 1) ' Spalte aus Array zurückholen
Next lZeile ' nächste Zeile
Next iSpalte ' nächste Spalte
Application.ScreenUpdating = True ' Bildschirm Update freigeben
End Sub
'
' aufbauen eines Test Tabellenblattes
'
Public
Sub Fuellen()
Dim lZeile As Long ' For/Next Zähler der Zeilen
Dim iSpalte As Integer ' For/Next Zähler der Spalten
Dim lZahl As Long ' Zähler 1 bis 20.000
Application.ScreenUpdating = False ' Bildschirm Update unterbinden
For iSpalte = 1 To 8 ' Spalte A bis H
lZahl = 1 ' Zähler auf 1 setzen
For lZeile = 1 To 20000 ' Zeile 1 bis 20.000
Cells(lZeile, iSpalte).Value = lZahl ' lfd. Zähler einfügen
lZahl = lZahl + 1 ' Zähler erhöhen
Next lZeile ' nächste Zeile
Next iSpalte ' nächste Spalte
Application.ScreenUpdating = True ' Bildschirm Update freigeben
End Sub
'
' Übertragen nach Tabelle2 aus Tabelle1 von hinten nach vorn
' Komplett zurück übertragen und Zwischenbereich löschen
'
Public
Sub Tauschen()
Dim WkSh_Q As Worksheet ' Quell-Tabellenblatt, mit den Herkunftsdaten
Dim WkSh_Z As Worksheet ' Ziel-Tabellenblatt, zum Empfang der Daten
Dim lZeile_Q As Long ' Zeilenzähler Quelldaten
Dim lZeile_Z As Long ' Zeilenzähler Zieldaten
Application.ScreenUpdating = False ' Bildschirm Update unterbinden
Set WkSh_Q = Worksheets("Tabelle1")
Set WkSh_Z = Worksheets("Tabelle2")
lZeile_Q = 20000 ' Zähler auf die letzte Zeile einstellen
For lZeile_Z = 1 To 20000 ' von 1 bis 20.000
WkSh_Z.Range("A" & lZeile_Z & ":H" & lZeile_Z).Value = _
WkSh_Q.Range("A" & lZeile_Q & ":H" & lZeile_Q).Value
lZeile_Q = lZeile_Q - 1 ' von 20.000 bis 1
Next lZeile_Z
WkSh_Q.Range("A1:H20000").Value = WkSh_Z.Range("A1:H20000").Value
WkSh_Z.Range("A1:H20000").ClearContents
Application.ScreenUpdating = True ' Bildschirm Update freigeben
End Sub
- - - - -
Übrigens, bin ich für das beißen zuständig ;)
Dnk` Dir (Euch) schon jetzt für Eure Mithilfe.
Mit besten Wünschen & weiterhin viel Erfolg