Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
612to616
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
612to616
612to616
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Lösungsvorschlag VB

Lösungsvorschlag VB
23.05.2005 14:58:51
Slugger
Hallo,
Ich habe ein Verzeichnis mit Unterverzeichnissen. Darin sind ca 1000 Datenblätter enthalten. Jedes Datenblatt hat die gleiche Struktur und Form. Jedes Datenblatt hat aber eine andere Bezeichnung. Jedoch sind diese Datenblätter veraltet.
Problem:
Diese Datenblätter sollen auf die neue Version gebracht werden. Die neue Version sieht mit Struktur und Form genauso aus wie die alte.
Es sollen alle Daten die in den Feldern der alten Datenblätter angegeben sind (z. B. A1 bis A14) in je ein neues Datenblatt (neue Version) kopiert werden.
Bei 1000 Dateien dauert dies seeeeehr lange, wenn man immer nur ein einziges auf einmal bearbeiten kann.
Mein Lösungsansatz:
Ich öffne ein neues Datenblatt, klicke auf einen Button. Danach soll ein altes Datenblatt aufmachen, die Daten kopieren und in ein anderes Verzeichnis, jedoch mit dem Dateinamen des alten Datenblattes abspeichern. Dann das nächste Blatt, solange bis keines mehr übrig ist. Jedoch soll dies so geschehen, das das VB ganz alleine bewerkstelligt. Ohne das man für jedes alte Blatt ein neues aufmachen muss. Eigentlich müssen die alten Daten importiert und unter dem Namen gespeichert werden. Danach die Daten die importiert wurden löschen und nächstes alte Datenblatt.
Wer hat eine Idee wie ich sowas mit VB hinbekomme. Das kopieren von einem ins andere Blatt habe ich schon erledigt.
Gruß Slugger

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Lösungsvorschlag VB
24.05.2005 07:48:31
Harald
Hi Slugger,
da du nicht geschrieben hast, wie und worin sich die Dateinamen unterscheiden.
Hier mal kurz aus dem Handgelenk ein grober Lösungsansatz.
Schreib die 1000 Namen der alten Fassungen (sollten in einem Ordner sein)in Spalte A (neue Mappe) untereinander.
Und in Spalte B, dieselben Namen mit einem neuen Ordner-Namen unter dem Du die aktualisierte Fassung speicherst.

Sub DateiOeffnen()
for n = 1 to 1000
on error resume next
Workbooks.Open Range("A" & n).Value 'ggf vor Range noch den Namen der neuen Mappe
call kopieren
call Speichern
next n
End Sub


Sub kopieren
'dein Kopiermakro
End Sub


Sub Speichern()
with ThisWorkbook
.SaveAs _
FileName:=Range("B"& n).Value
. close
end with
End Sub

Gruß
Harald
Anzeige
AW: Lösungsvorschlag VB
24.05.2005 08:21:59
Slugger
Hallo,
vielen Dank schon mal für die Hilfe.
Also die Dateinamen sind wie gesagt unterschiedlich. Der erste heißt bspw. Puma567, der nächste Nike567/2. So in dieser Art muss man sich das vorstellen. Jeder Name ist anders.
Ich hab mir das so gedacht:
Die Dateinamen hab ich schon mal ausgelesen und in Tabelle2 von meiner neuen Dateiversion reingeschrieben. Nun müsste er den ersten Dateinamen in einem Verzeichnis mit Unterverzeichnissen suchen und diese Datei öffnen. Nun starte ich mein Kopieren Makro. Die alte Datei schließt sich, und speichert die neue Datei unter dem Namen der alten in ein neues Verzeichnis ab. Danach löscht es alle Daten die vorher eingetragen wurden und das Spiel beginnt von vorne, nur mit dem nächsten Dateinamen.
Ich hab schon verschiedene Ansätze, nur leider klappt das im Moment noch nicht so richtig.
Gruß Slugger
Anzeige
AW: Lösungsvorschlag VB
24.05.2005 08:40:40
Harald
Hi Slugger,
wir haben jetzt verschiedene Möglichkeiten
- Du bastelst solange, bis es läuft
- ich kauf mir ne Glaskugel
- oder Du gibst an, wo genau es bei deinem bisherigen Ansatz hakt und man kann weitere Ansätze bilden
;-))
Gruß
Harald
AW: Lösungsvorschlag VB
24.05.2005 08:56:17
Slugger
Hallo,
also die Glaskugel war schon mal keine schlechte Idee. Ok, mein Problem ist das ich nicht weiß wie ich VB das klarmache das es die Namen aus der Tabelle nimmt. Bisher habe ich das einfach mit einer Input Box gelößt. Nur bei 1000 Dateien ist das etwas umständlich. Ich müsste das irgendwie automatisieren wie in deinem Vorschlag, meine Kenntnisse reichen aber dafür noch lange nicht aus. Ich habe die Dateinamen erst mal in Tabelle2, SpalteD reinschreiben lassen.

Private Sub Cmdtest6_Click()
ActiveSheet.Unprotect ("xxx")
Dim i As Long
Dim nummer As String
Dim fs As FileSearch
nummer = InputBox("Bitte geben Sie die Artikelnummer an ", "Artikelnummer", "")   // Hier das Problem //
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "H:\FT13\Artikeldatenbank\Saison\Sai112"
.SearchSubFolders = True
.Filename = nummer
.FileType = msoFileTypeExcelWorkbooks
.Execute
If .Execute() > 0 Then
MsgBox fs.FoundFiles.Count
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles.Item(i)
Workbooks.Open Filename:=.FoundFiles(i)
ActiveWorkbook.Worksheets("Formblatt").Range("B6:D6").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B6:D6")
ActiveWorkbook.Worksheets("Formblatt").Range("L6").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("L6")
ActiveWorkbook.Worksheets("Formblatt").Range("B9:B13").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B9:B13")
ActiveWorkbook.Worksheets("Formblatt").Range("D9:D13").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("D9:D13")
ActiveWorkbook.Worksheets("Formblatt").Range("F9:F13").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("F9:F13")
ActiveWorkbook.Worksheets("Formblatt").Range("H9:J13").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("H9:J13")
ActiveWorkbook.Worksheets("Formblatt").Range("H9:J9").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("J16:J18")
ActiveWorkbook.Worksheets("Formblatt").Range("L16").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("L16")
ActiveWorkbook.Worksheets("Formblatt").Range("N16").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("N16")
ActiveWorkbook.Worksheets("Formblatt").Range("L18").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("L18")
ActiveWorkbook.Worksheets("Formblatt").Range("N18").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("N18")
ActiveWorkbook.Worksheets("Formblatt").Range("B21:D21").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B21:D21")
ActiveWorkbook.Worksheets("Formblatt").Range("F21").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B24:N26")
ActiveWorkbook.Worksheets("Formblatt").Range("B29:D29").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B29:D29")
ActiveWorkbook.Worksheets("Formblatt").Range("B32:D32").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B32:D32")
ActiveWorkbook.Worksheets("Formblatt").Range("B35:D35").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B35:D35")
ActiveWorkbook.Worksheets("Formblatt").Range("B38").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B38")
ActiveWorkbook.Worksheets("Formblatt").Range("D38").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("D38")
ActiveWorkbook.Worksheets("Formblatt").Range("B41").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("B41")
ActiveWorkbook.Worksheets("Formblatt").Range("D41").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("F55:H57")
ActiveWorkbook.Worksheets("Formblatt").Range("J55:N57").Copy _
Destination:=Workbooks("artikelblatt-vordruck-Sai112.xls").Sheets("Formblatt").Range("J55:N57")
With ThisWorkbook
.SaveAs _
Filename:=i
.Close
End With
Next i
End If
End With
ActiveSheet.Protect ("xxx"), DrawingObjects:=False, Contents:=True, Scenarios:= _
True
End Sub

gruß Slugger
Anzeige
AW: Lösungsvorschlag VB
24.05.2005 09:31:34
Slugger
Hallo,
was auch noch eine Lösung wäre, wenn ich Tabelle3 und Tabelle4 von den neuen Blättern irgendwie in die alten einfügen könnte. Muss ja nicht VB sein. Nur schnell soll es gehen.
Gruß
Slugger
AW: Lösungsvorschlag VB
24.05.2005 09:41:18
Harald
Hi Slugger,
schön dass Du die Herber-CD auch nutzt ;-))
Ich würd das Pferd folgendermassen aufzäumen. Grundlagen schaffen !
Neue Mappe anlegen, das da ins Modul und laufen lassen (sofern die Pfadangabe stimmt)

Sub Einlesen()
Dim fs As FileSearch
Dim iCounter As Integer, i as Integer
Dim Transf As String
Application.ScreenUpdating = False
Sheets(1).Columns("A:E").ClearContents
Sheets(1).Range("a1") = " Pfad\Stand:\" & "=today()" & " \ \Dateiliste"
Transf = "H:\FT13\Artikeldatenbank\Saison\Sai112"
Set fs = Application.FileSearch
i = 2
With fs
.FileType = mmsoFileTypeExcelWorkbooks
.LookIn = Transf
.Execute
For iCounter = 1 To .FoundFiles.Count
Sheets(1).Cells(i, 1).Value = .FoundFiles(iCounter)
i = i + 1
Next iCounter
End With
Range("c1").Select
Application.ScreenUpdating = True
End Sub

Somit hast Du die Grundlage für die "Öffnen"-Schleife per
Workbooks.Open Range("A" & n).Value
Siehe erstes Posting. Änderung nur für den Schleifenzähler
n = 2 to cells(rows.count, 1).end(xlup).row
Kopier die gefundenen Files von A2: A? nach B2: B?. Per Suchen/Ersetzen kannst Du in Spalte B dann z.B. "Sai112" in "Sai112_neu" ändern und hast somit die Grundlage für die "Speichern_unter" Schleife in einem neuen Ordner.
ThisWorkbook.SaveAs _
FileName:=Range("B" & n).Value
activewindow.close
dann die "Alte" schliessen und next n
Die alten Dateien, würde ich erst nach erfolgreichem Durchlauf en bloc im Explorer löschen.
Na denn...viel Spass und noch mehr Erfolg ;-))
Harald
Anzeige
AW: Lösungsvorschlag VB
24.05.2005 11:00:20
Slugger
Hallo,
ja danke, das ist das was ich gesucht habe. Vielen, vielen Dank für die Mühe.
Wünsche noch einen schönen Tag
Gruß
Slugger
Gern geschehen...o.T
24.05.2005 11:04:15
Harald
Gruß Harald

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige