|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
18.07.2008 21:29:40 |
Konrad |
|
|
|
19.07.2008 17:49:14 |
jh |
|
|
|
21.07.2008 13:13:54 |
Konrad |
|
|
|
21.07.2008 20:22:51 |
jh |
|
|
 Aw:Aw:Aw:Aw:Verschachtelte For-Next-Schleife |
22.07.2008 07:53:38 |
jh |
|
|
|
23.07.2008 00:36:29 |
Konrad |
|
|
|
23.07.2008 06:56:36 |
jh |
|
|
|
23.07.2008 14:43:11 |
jh |
|
|
Von:
jh |
Datum:
22.07.2008 07:53:38 |
Views:
1326 |
Rating:
|
Antwort:
|
Thema:
Aw:Aw:Aw:Aw:Verschachtelte For-Next-Schleife |
Hallo,
so, nun ist die Sache schon klarer. Kommentare zu den Bedingungen
und Voraussetzungen, die der Funktionsweise zugrunde liegen, sind
an der jeweiligen Stelle eingefügt. Falls irgend etwas davon nicht
den tatsächlichen Gegebenheiten entspricht, melde dich noch mal.
Natürlich auch, wenn es sonst noch Fragen gibt.
Const Quellordner As String = "C:\Quelldateien\"
Const Zielordner As String = "C:\Zieldateien\"
' Beispiel, Ordnernamen anpassen!
Dim vntAuswahl As Variant, lngAuswahl As Long
' Benutzerauswahl - zu bearbeitende Quelldateien
Dim Quelle As Workbook, Ziel As Workbook
' diverse Hilfsvariable:
Dim lngSheetsInNewWB As Long
Dim lngRow As Long
Dim strName As String
ChDrive "C"
ChDir Quellordner
' ChDrive/ChDir ist nur erforderlich, damit
' GetOpenFileName im gewünschten Ordner beginnt
vntAuswahl = Application.GetOpenFilename( _
FileFilter:="Microsoft-Excel-Dateien (*.xl*), *.xl*", _
MultiSelect:=True)
' Der Open-Dialog gibt mit MultiSelect ein Array mit den
' ausgewählten Dateien zurück (auch wenn nur eine Datei
' gewählt wurde). Wurde auf Abbrechen geklickt, wird False
' zurückgegeben (IsArray ist in dem Fall Falsch).
If Not IsArray(vntAuswahl) Then
Exit Sub
Else
Application.ScreenUpdating = False
' beschleunigt die Bearbeitung durch Verzicht
' auf Aktualisierung der Bildschirmanzeige
lngSheetsInNewWB = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
For lngAuswahl = LBound(vntAuswahl) To UBound(vntAuswahl)
' nacheinander alle ausgewählten Dateien bearbeiten
If vntAuswahl(lngAuswahl) = ThisWorkbook.FullName Then
' Diese Arbeitsmappe nicht nochmals öffnen
Set Quelle = Nothing
Else
Set Quelle = Workbooks.Open(vntAuswahl(lngAuswahl))
End If
If Not Quelle Is Nothing Then
Set Ziel = Workbooks.Add
lngFirstRow = 9004
With Quelle.Worksheets("Tabelle1")
' ggf. Tabellennamen anpassen, dieser muss in allen
' Quelldateien identisch sein. Andere Möglichkeit:
' Index verwenden - Worksheets(1) - dann müssen in
' allen Quelldateien die Daten auf dem ersten Blatt
' stehen
Do Until IsEmpty(.Cells(lngFirstRow, 1))
' Damit diese Schleifenbedingung korrekt arbeitet, muss die
' Anfangszeile jedes Blocks in Spalte A einen Eintrag enthalten!
.Range(.Cells(lngFirstRow, 1), .Cells(lngFirstRow + 17999, 2)).Copy
Ziel.ActiveSheet.Range("B3").PasteSpecial xlPasteAll
Ziel.ActiveSheet.Range("A1").Select
' aktuelle Auswahl aufheben (eingefügter Bereich)
Application.CutCopyMode = False
lngFirstRow = lngFirstRow + 30000
If lngFirstRow > .Rows.Count Then Exit Do
' Fehler vermeiden, wenn Variable größer wird als maximale Zeilenzahl
If Not IsEmpty(.Cells(lngFirstRow, 1)) Then
Ziel.Worksheets.Add After:=Ziel.ActiveSheet
End If
Loop
End With
strName = Quelle.Name
' Datei im Zielordner unter dem gleichen Namen speichern wie Quelldatei
Quelle.Close False
Ziel.Worksheets(1).Select
' erstes Blatt auswählen
Application.DisplayAlerts = False
Ziel.SaveAs Zielordner & strName
' wenn im Zielordner schon eine Datei gleichen Namens
' existiert, wird sie ohne Rückfrage überschrieben
Application.DisplayAlerts = True
Ziel.Close False
End If
Next lngAuswahl
Application.SheetsInNewWorkbook = lngSheetsInNewWB
Application.ScreenUpdating = True
End If
Gruß
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
18.07.2008 21:29:40 |
Konrad |
|
|
|
19.07.2008 17:49:14 |
jh |
|
|
|
21.07.2008 13:13:54 |
Konrad |
|
|
|
21.07.2008 20:22:51 |
jh |
|
|
Aw:Aw:Aw:Aw:Verschachtelte For-Next-Schleife |
22.07.2008 07:53:38 |
jh |
|
|
|
23.07.2008 00:36:29 |
Konrad |
|
|
|
23.07.2008 06:56:36 |
jh |
|
|
|
23.07.2008 14:43:11 |
jh |
|
|