Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Makro für Inventur





Frage

Hi nighty, kannst du mir noch mal helfen? Ich habe schon in verschiedenen Excel Foren nach Hilfe gesucht aber irgendwie hat keiner eine Lösung. Mein Porzellanprogramm ist jetzt fast fertig. Aber: Ich brauche noch mal ein neues Makro bezüglich der "Inventur". Es sollen die Summen von Bestellformularen in einer Datei zusammengefasst werden. Beispiel: Ich habe zwei Dateien im gleichen Unterverzeichnis. Die erste Datei heißt Mueller.xls. Die zweite Datei heißt Meier.xls. In beiden Dateien stehen in den gleichen Zellen, (ZB. A1= Teller, B1=Messer usw.) Artikel die der jeweilige Kunde leihen möchte. Nun soll in einer separaten Datei (gleiches Unterverzeichnis) automatisch die Gesammtzahl der bestellten Artikel stehen. D.h, eine Addition der Zellen der verschiedenen Dateien. Problem: 1) Die Dateinamen sind vorher nicht bekannt 2) Die Anzahl der Dateien /Kunden variiert 3) Die Dateien sind geschlossen 4) Jede Datei besteht aus vier Tabellen ("Bestell1","Bestell2","Bestell3","Bestell4") 5) Es gibt eine Datei namens RECH.xls deren Inhalt nicht mitgezählt werden soll. Vielen Dank im vorraus. Gruß Ben

Antwort 1 von nighty

hi ben :)

wenn schon in der datei die artikel gezählt werden könnten ,dann wäre wahrscheinlich nur ein wert den man ohne oeffnen uebergeben koennte,ist dies machbar ?

geht natuerlich auch so,doch wuerde es ein wenig den makroablauf beschleunigen

gruss nighty

Antwort 2 von Ben1

Hi nighty,
super das du dich meldest!
Klar. Ich könnte in jeder Datei eine Spalte einrichten wo die vier Bestellungen vorab addiert werden.
Dann müßte ich nur die Werte dieser Spalte übergeben an meine Invertur-Datei.

Gruß
Ben

Antwort 3 von nighty

hi ben :)

hier erst mal ein anfang

gruss nighty

zur zeit wird aus einem angegebenen pfad alle dateien mit der endung xls ausgelsen,im geschlossenen zustand

auszulesende zelle ist a1 von 4 sheets ausgehend addiert,ausgeschlossen die datei "RECH.xls"

auf dem aktiven sheet zeile 1 spalte 3 erfolgt zur zeit die ausgabe

Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim Zeichen As Integer
Dim Tabellen As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Cells(1, 3) = ""
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen
If DateiName <> "RECH.xls" Then
For Tabellen = 1 To 4
ActiveSheet.Cells(1, 3) = ActiveSheet.Cells(1, 3) + _
ExecuteExcel4Macro("´C:\test3\" & "[" & DateiName & "]" & Sheets(Tabellen).Name & "´!" & Range("A1").Address(, , xlR1C1))
Next Tabellen
End If
Next Dateien
End If
End With
End Sub

Antwort 4 von nighty

hi ben :)

hier mit bereichsangaben der auszulesenden zellen

Set bereich = Range("A1:A3")

gruss nighty

Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim Zeichen As Integer
Dim Tabellen As Integer
Dim DateiName As String
Dim bereich As Range
Dim zelle As Range
Set bereich = Range("A1:A3")
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Cells(1, 3) = ""
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen
If DateiName <> "RECH.xls" Then
For Tabellen = 1 To 4
For Each zelle In bereich
ActiveSheet.Cells(1, 3) = ActiveSheet.Cells(1, 3) + _
ExecuteExcel4Macro("´C:\test3\" & "[" & DateiName & "]" & Sheets(Tabellen).Name & "´!" & zelle.Address(, , xlR1C1))
Next zelle
Next Tabellen
End If
Next Dateien
End If
End With
End Sub

Antwort 5 von woher

Hallo,
es gibt meines Wissens auch die Möglichkeit Summen über mehrere Dateien hinweg zu bilden. Aber wie? Ich hab das mal irgendwo gesehen, schien recht einfach, aber ich finde es nicht wieder.
mfg
woher

Antwort 6 von CaroS

Hallo woher,

ich vermute, dass sich Deine Frage auf Formeln und nicht auf VBA bezieht. Dann wäre die Antwort z. B.:
=[Datei_1.xls]Tabelle1!$A$1+[Datei_2.xls]Tabelle2!$B$2+[Datei_3.xls]Tabelle3!$C$3

In VBA dürfte es sowieso keine Probleme geben, Daten aus mehreren Dateien gleichzeitig zu verarbeiten.

Gruß,
CaroS

Antwort 7 von Ben1

Hi woher / Hi CaroS,
was macht ihr wenn die Dateinamen vorab nicht bekannt sind?
Ich meine, du hast ein Verzeichnis aber du weißt nicht wieviele Dateien zusammen kommen und wie sie heißen.

Es sollen einfach alle Dateien in dem Verzeichniß addiert werden.

Gruß
Ben

Antwort 8 von Ben1

Hi nighty,
ich komme nicht wirklich klar.
Wie sieht der Pfad aus wenn ich bei jeder Datei den Inhalt aus einer ganz bestimmten Zelle auslesen möchte?
z.B.

C:\test3\alle Dateien.xls\Tabelle1\Zelle"H2"

LookIn = "C:\test3\[*.xls]Tabelle1!$H$2"

Funktioniert irgendwie nicht.

Gruß
Ben

Antwort 9 von CaroS

Hi Ben1,

zu A6, A7: Ich dachte, ich "räume" diese Frage am besten gleich "ab", denn es war nicht klar, ob und wie viel sie mit der Lösung Deines Problems und dem VBA-Code von nighty zu tun hat. Nighty holt sich ja mit 3 verschachtelten Schleifen der Reihe nach alle A1-Werte und addiert sie sukkzessive: ActiveSheet.Cells(1, 3) = ActiveSheet.Cells(1, 3) + ... zelle.Address(, , xlR1C1) . Das ist richtig so, wenn die Anzahl und die Namen der Excel-Dateien erst ermittelt werden müssen.

Da dachte ich, wenn sich jemand vielleicht nur an die Syntax von
[Datei-Name.xls]Tabelle-Name!Zellbezug erinnern möchte, dann kann er das haben und sich damit eine SUMME() oder eine einfache Addition zusammenbauen. Eine Formel-Lösung wollte ich nicht diskutieren.

Gruß,
CaroS

Antwort 10 von nighty

hi ben :)

sag welches zielverzeichnis und welche zellen aus welchen sheets gefordert werden und wo das ergebnis dargestellt werden sollte,dann pass ich das entsprechend an.

zur zeit noch als pfad "C:\test3"
als auszulesende zelle wird H2 von den ersten 4 sheets gelesen

gruss nighty

Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim Zeichen As Integer
Dim Tabellen As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Cells(1, 3) = ""
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen
If DateiName <> "RECH.xls" Then
For Tabellen = 1 To 4
ActiveSheet.Cells(1, 3) = ActiveSheet.Cells(1, 3) + _
ExecuteExcel4Macro("´C:\test3\" & "[" & DateiName & "]" & Sheets(Tabellen).Name & "´!" & Range("A1").Address(, , xlR1C1))
Next Tabellen
End If
Next Dateien
End If
End With
End Sub

Antwort 11 von Ben1

Hi nighty,
Zielverzeichnis soll sein C:\Porz

Ausgelesen werden jeweils 4 sheets pro Datei.

Aus jedem sheet sind immer die gleichen Zelle notwendig. Also immer "H2", "H3","H4" usw.
(In jeder Zelle steht ein anderer Artikel Z.B. H2=Teller,H3=Messer usw.)

Das Ergebnis soll in einer Datei namens "Inv.xls"
dargestellt werden.
Die Zellen sollen gleich sein ("H2", "H3","H4" usw.)

Gruß
Ben

Antwort 12 von Ben1

Ach so . Noch was.

Meine Aufträge (Dateien) sollen auch in "C:\Porz"
stehen.

Die "Inv.xls" kann auch in einem Unterverzeichns stehen.
Das ist nicht so wichtig.

Antwort 13 von nighty

hi ben :)

H2-H4 oder auch weiter sollten die gezählten werte stehen und keine bezeichner oder versteh ich da was falsch ?

RECH.xls wird nicht mitgezählt

das makro kann ja in die ausgeschlossene datei eingefuegt werden,ausgabe ist immernoch C1 des aktiven sheets

gruss nighty

Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim Zeichen As Integer
Dim Tabellen As Integer
Dim DateiName As String
Dim bereich As Range
Dim zelle As Range

Rem dein bereich

Set bereich = Range("H2:H4")

With Application.FileSearch
.NewSearch
.LookIn = "C:\Porz"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
Cells(1, 3) = ""
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen
If DateiName <> "RECH.xls" Then
For Tabellen = 1 To 4
For Each zelle In bereich
ActiveSheet.Cells(1, 3) = ActiveSheet.Cells(1, 3) + _
ExecuteExcel4Macro("´C:\Porz\" & "[" & DateiName & "]" & Sheets(Tabellen).Name & "´!" & zelle.Address(, , xlR1C1))
Next zelle
Next Tabellen
End If
Next Dateien
End If
End With
End Sub

Antwort 14 von Ben1

Hi nighty,

ich gebe es auf. Es funktioniert einfach nicht. Es wird mir langsam schon peinlich dich zu fragen.

Mein letzter Versuch. Eine neue Idee:

Kannst du mir sagen, wie das Makro aussehen muß, wenn ich
Nur Eine Zelle auslesen möchte (z.B. „H2“)
Diese Zelle steht immer im Datenblatt „D“ der einzelnen / verschiedenen Dateien.

Das Makro muß also aus verschiedenen Dateien ,deren Name nicht bekannt ist, immer die Zelle „H2“ in dem Datenblatt „D“ addieren.

Gruß
Ben

Antwort 15 von nighty

hi ben :)))

dann so :)

gruss nighty

Option Explicit
Sub makro01()
On Error GoTo fehler
Dim Dateien As Integer
Dim Zeichen As Integer
Dim DateiName As String
Dim Beenden As String
With Application.FileSearch

rem löschung der AusgabeZelle

ActiveSheet.Cells(1, 1).Clear

.NewSearch
.LookIn = "C:\Porz"
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen

rem AusgabeZelle ActiveSheet.Cells(1, 1)

ActiveSheet.Cells(1, 1) = ActiveSheet.Cells(1, 1) + ExecuteExcel4Macro("´C:\Porz\" & "[" & DateiName & "]D" & "´!" & Range("H2").Address(, , xlR1C1))
Next Dateien
End If
End With
End
fehler:
If Err = 13 Then
Beenden = MsgBox("In der Datei " & UCase(DateiName) & " existiert keine Tabelle namens D" & Chr$(13) & " Trotzdem Weiterarbeiten", vbYesNo)
If Beenden = vbYes Then Resume Next
End If
End Sub

Antwort 16 von Ben1

Hi nighty,

kann mich, aus Zeitgründen, erst am Montag wieder mit der Sache beschäftigen.
Werde das Makro dann einarbeiten.

VIELEN DANK für deine Hilfe!!!!!

Super Klasse! - Danke

Gruß
Ben

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: