Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
812to816
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
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

MAKRO erweitern !?

MAKRO erweitern !?
31.10.2006 16:11:57
Leo
Hallo zusammen,
das mit meinen MAKRO scheint eine never ending Story zu werden - falls mir nicht einer von euch noch einmal hilft.
Tasso - ein aufmerksamer Forumteilnehmer - war einmal so nett und hatte mir folgendes MAKRO schon einmal geschrieben ...
https://www.herber.de/bbs/user/32811.zip
So weit so gut - doch ich habe jetzt ein größeren Datenfeed zu bearbeiten und würde dem Forum hier weiterhin verbunden bleiben, falls ein Boardteilnehmer in der Lage wäre, das MAKRO von Spalte H auf bis zu Spalte Z zu erweitern.
Vielleicht liest Du das ja TASSO - jasu - ist wirklich, nein tatsächlich, dass letzte Mal, dass ich mit diesem Problem hier haussieren gehe.
Mit besten Wünschen & weiterhin viel Erfolg :
Leo van der Haydn

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: MAKRO erweitern !?
31.10.2006 16:21:15
lueckii
Hallo Leo!
Einfach
x = Range("A1:I1").End(xlDown).Row
durch
x = Range("A1:Z1").End(xlDown).Row
ersetzen.
Gruß Martin
AW: MAKRO erweitern !?
31.10.2006 16:23:38
Klaus
Hallo Leo,
Dies ist dein Makro:

Sub Test()
Application.ScreenUpdating = False
Dim x$
With ActiveScheet
x = Range("A1:H1").End(xlDown).Row
Range("I1").Value = 1
Range("I1").AutoFill Destination:=Range("I1:I" & x), Type:=xlFillSeries
Range("A1:I" & x).Sort Key1:=Range("I1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'Application.ScreenUpdating = True 'Falls Modal -Userform inaktiviert
End Sub

Ich kenn jetzt die Vorgeschichte nicht, aber ändere doch mal in Zeile 5 auf
x = Range("A1:Z1").End(xlDown).Row
Die Hilfsspalte I ist wohl ein Feld rechts außerhalb des Bereiches? Bei einer Ausweitung auf Z müsste also jedes I in AA (die Spalte nach Z) getauscht werden. Das neue Makro währe dann:
Sub Test()
Application.ScreenUpdating = False
Dim x$
With ActiveScheet
x = Range("A1:Z1").End(xlDown).Row
Range("AA1").Value = 1
Range("AA1").AutoFill Destination:=Range("AA1:AA" & x), Type:=xlFillSeries
Range("A1:AA" & x).Sort Key1:=Range("AA1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
'Application.ScreenUpdating = True 'Falls Modal -Userform inaktiviert
End Sub
Und das sollte es dann sein, oder?
Falls ich das Makro komplett falsch verstanden habe, lass ich mal offen ...
Gruß,
Klaus M.vdT.
P.S.: es hilft, einen Link auf den alten Thread zu setzen.
Anzeige
AW: MAKRO erweitern !?
31.10.2006 17:30:56
Leo
Danke euch zusammen,
aber ich bin wiegesagt kein Excel-Profi bzw. kennen mich mit MAKROS gar nicht aus !!!
TASSO war damals so nett und schrieb mir den MAKRO selbst und lud ihn entsprechend hoch. Ich wäre nicht nur euch beiden, sondern auch dem ganzen BOARD auf in zukunft weiterhin verbunden - wenn sich vielleicht einer von euch beiden (oder sonstwer) sich kurz die Mühe machen könnte die Datei herunterzuladen, entsprechend umzuprogrammieren und wieder hochzuladen.
Hab die Dazeit vorhin auch deswegen hochgeladen ...
Dank` euch schon jetzt für eure Hilfsbereitschaft !!!!
Mit besten Wünschen & weiterhin viel Erfolg :
Neo 23
Anzeige
AW: MAKRO erweitern !?
01.11.2006 07:37:41
Klaus
aber ich bin wiegesagt kein Excel-Profi bzw. kennen mich mit MAKROS gar nicht aus !!!
Makros beißen nicht :-)
Step by Step:
- öffne Excel
- Öffne die fragliche Datei
- Drücke die Tastenkombination ALT+F11
Dies ist der VBA - Editor, hier werden die Makros gespeichert.
- Drücke die Tastenkombination STRG+R
Das links, was so ähnlich aussieht wie ein Verzeichnissbaum und jetzt aktiv ist, ist der Projekt-Explorer. Da öffnest du die Struktur von VBAProjekt(DeinDateiname), dann Module. Click die Module (oder das Modul) durch, bis du die Seite mit o.g. Quellcode findest. Markiere den Code hier und kopiere ihn über deinen Code. Speichern, fertig.

Sub Test()
Application.ScreenUpdating = False
Dim x$
With ActiveSheet
x = .Range("A1:Z1").End(xlDown).Row
.Range("AA1").Value = 1
.Range("AA1").AutoFill Destination:=Range("AA1:AA" & x), Type:=xlFillSeries
.Range("A1:AA" & x).Sort Key1:=Range("AA1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
End Sub

Anzeige
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige