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

Formel in mehrere Dateien eintragen lassen

Formel in mehrere Dateien eintragen lassen
07.06.2002 08:16:22
MikeS
Hallo Leute,

habe nachfolgendes Problem:

In meinem Hauptordner z.B. (C:\Eigene Dateien\Hauptordner\) gibt es weitere
Unterordner, die jede Menge Excel-Dateien enthalten.

Nun möchte ich alle xls.-Dateien, die im Hauptordner und den Unterordnern gefunden werden,
nacheinander öffnen und in die Zelle B2 eine Formel eintragen lassen.

Dann soll die jeweilige Datei gespeichert / geschlossen werden und die nächste Datei
bearbeitet werden.

Jede Datei hat die gleiche Struktur.

Kann man das vielleicht irgendwie realisieren???

Vielen Dank, ciao MikeS

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Moment
07.06.2002 08:41:01
andré
-
Re: Moment
07.06.2002 08:44:22
andré

sowas änliches hab ich auch grad gebaut, nur das ich die dateien dann etwas komplizierter duchsuche. (das steht zwischen den kommentarzeilen) aber die suchroutine (supercool!!!) kannst du ja verwenden. es ginge garantiert auch einfacher mit appication.filesearch aber ich habs so gemacht dann kann ichs später vielleicht auch mal in VB einsetzen.

viel Spaß


Option Explicit

Dim Such As String
Dim Pfad As String
Private Type DB
Pfad As String
Indx As Long
Ebene As Integer
End Type
Dim FolderDB() As DB
Dim Indx As Long 'zähler für speipfad
Dim Ebene As Integer 'zähler für Ordnerebene
Dim i As Long
Dim LstEin As String

Dim ActSh As Worksheet
Dim ActRe As Range
Dim TmpStr As String
Dim Msg

Dim Suchtxt As String
Dim Ersetztxt As String

Private Sub cmd_Click()

Msg = MsgBox("Prozess für den Ordner:" & Chr(13) + Chr(10) & txt_Pfad.Text & Chr(13) + Chr(10) & "starten?", 4404, "Prozess starten")

If Msg = 7 Then
Exit Sub
End If

lst.Clear
Erase FolderDB()
ReDim FolderDB(0)
Indx = 0
Ebene = 0

Suchtxt = txt_suchtxt.Text
Ersetztxt = txt_ersetztxt.Text

FolderDB(0).Pfad = txt_Pfad.Text
FolderDB(0).Indx = 0
FolderDB(0).Ebene = 0

While FolderDB(0).Pfad <> ""

Pfad = FolderDB(0).Pfad
Indx = FolderDB(0).Indx
Ebene = FolderDB(0).Ebene

Such = Dir(Pfad, vbDirectory)
While Such <> ""
If Such <> ".." And Such <> "." Then
If GetAttr(Pfad & Such) = 16 Then
'wenn ordner
LstEin = ""
For i = 0 To Ebene - 1
LstEin = LstEin & "| "
Next i
LstEin = LstEin & "|-|" & Such
lst.AddItem LstEin, Indx
For i = 1 To UBound(FolderDB())
If FolderDB(i).Indx > Indx Then
FolderDB(i).Indx = FolderDB(i).Indx + 1
End If
Next i
ReDim Preserve FolderDB(UBound(FolderDB()) + 1)

FolderDB(UBound(FolderDB())).Pfad = Pfad & Such & "\"
FolderDB(UBound(FolderDB())).Indx = Indx + 1
FolderDB(UBound(FolderDB())).Ebene = Ebene + 1

Indx = Indx + 1
Else
'wenn datei

'-----------------------------------------------------datei bearbeiten-----------------------------
If InStr(Such, ".xls") Then

Application.ScreenUpdating = False
Workbooks.Open Filename:=Pfad & Such, UpdateLinks:=0
Application.DisplayAlerts = False

For Each ActSh In Worksheets

ActSh.Activate
ActiveSheet.Unprotect ("qmp")

For Each ActRe In ActSh.UsedRange.Cells
ActRe.Activate
If ActRe.HasFormula Then
If InStr(ActRe.Formula, Suchtxt) Then
ActRe.Formula = Replace(ActRe.Formula, Suchtxt, Ersetztxt)
End If
End If
Next ActRe

ActiveSheet.Protect "qmp", DrawingObjects:=True, Contents:=True, Scenarios:=True

Next ActSh

Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True

End If
'-----------------------------------------------------datei bearbeiten ende-----------------------------

LstEin = ""
For i = 0 To Ebene - 1
LstEin = LstEin & "| "
Next i
LstEin = LstEin & "|-" & Such
lst.AddItem LstEin, Indx
For i = 1 To UBound(FolderDB())
If FolderDB(i).Indx > Indx Then
FolderDB(i).Indx = FolderDB(i).Indx + 1
End If
Next i

Indx = Indx + 1

End If
End If
Such = Dir
Wend

For i = 1 To UBound(FolderDB())
FolderDB(i - 1).Pfad = FolderDB(i).Pfad
FolderDB(i - 1).Indx = FolderDB(i).Indx
FolderDB(i - 1).Ebene = FolderDB(i).Ebene
Next i

If UBound(FolderDB()) > 0 Then
ReDim Preserve FolderDB(UBound(FolderDB()) - 1)
Else
FolderDB(0).Pfad = ""
End If
Wend

MsgBox "erfolgreich abgeschlossen", , "Meldung"

End Sub

Anzeige
Re: Moment
07.06.2002 08:47:48
andré
vielleicht noch etwas quelltexterläuterung:

die ganze ordnerstruktur die durchsucht wird, wird dann auch gleichzeitig in eine listbox mit dem namen "lst" eingetragen. der pfad der durchsucht wird wird über ein textfeld mit dem namen "txt_pfad" eingegeben.

mfg andré

Hilfe nötig
07.06.2002 09:00:10
MikeS
Hallo Andre`,

vielen Dank für Deine langen Code.

Den muß ich mir erstmal reinziehen.

Nun muß ich noch sagen, daß ich zwar nicht mehr ein blutiger Anfänger in Sachen VBA bin, aber doch noch in den "Anfängen" stecke.

So wird es bestimmt zu Problemen kommen, den Code für mich anzupassen.

Ich probier`s mal aus und melde mich später nochmal.

Ciao MikeS

Anzeige
Re: Hilfe nötig
07.06.2002 09:10:27
andré
wenn du noch den PAP dazu brauchst den hab ich auch noch da! in einer Visio datei ;)
Re: Hilfe nötig
07.06.2002 09:14:32
MikeS
Hallo Andre`,

was ist ein PAP???

Ciao MikeS

Programmablaufplan
07.06.2002 09:18:47
andré
da ist das ganze programm (der ablauf) grafisch aufgezeichnet
Re: Programmablaufplan
07.06.2002 09:20:57
MikeS
Hi Andre`,

dann schick mir bitte das Ding doch per mail.

Danke MikeS

kannst du visio dateien öffnen?
07.06.2002 09:22:29
andré

Käme auf einen Versuch an.
07.06.2002 09:23:44
MikeS

habs ihn dir geschickt, aber als gif
07.06.2002 09:28:41
andré

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige