Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Mehrere Excelfiles in eine Tabelle

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Mehrere Excelfiles in eine Tabelle (2824 mal gelesen)
thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 05. Dez. 2006 08:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Profis,

ich habe in einem Verz. C:\Bestellungen mehrere Stückliste liegen.
Alle Stücklisten beginnen in Zeile 15 und sind zwischen 20 und 50 Zeilen lang. Zur Zeit öffne ich alle einzeln und kopiere die Zeilen in ein Neue Tabelle um dort meine Bestellmakros auszuführen. Die Namen der Stücklisten sind immer unterschiedlich (Auftragsnummern).

Wie kann ich diese Arbeitsschritte(öffnen,kopieren,einfügen usw.) vereinfachen ?

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Paulchen
Mitglied
Bauing./SW-Entwickler


Sehen Sie sich das Profil von Paulchen an!   Senden Sie eine Private Message an Paulchen  Schreiben Sie einen Gästebucheintrag für Paulchen

Beiträge: 1227
Registriert: 19.08.2004

Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice

erstellt am: 05. Dez. 2006 09:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Hallo Marco,

in welcher Form liegen denn die Stücklisten vor? Textdateien, Excel, ...

Vielleicht hilft Dir ja (in xls) "Daten" - "Externe Daten" - ("Textdatei importieren") samt Assistent weiter? Excelmappen lassen sich auch als *.txt (Tabs getrennt) abspeichern.

Gruß,
Frederik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 05. Dez. 2006 10:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Frederik,

alle Files liegen in Excel vor. Diese werden aus dem CAD erzeugt und geben mir die Rohteilmaße für eine Bestellung. Jeder Arbeitsplatz legt die Bestell-Stücklisten auf dem Server in ein Verz. und der Rest wird von mir noch durch kopieren und einfügen gemacht um alles in einer Liste zusammenzufügen.

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Paulchen
Mitglied
Bauing./SW-Entwickler


Sehen Sie sich das Profil von Paulchen an!   Senden Sie eine Private Message an Paulchen  Schreiben Sie einen Gästebucheintrag für Paulchen

Beiträge: 1227
Registriert: 19.08.2004

Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice

erstellt am: 05. Dez. 2006 10:55    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Schön. Soviel für den Hinterkopf ;-) Was ist damit:
Zitat:
Vielleicht hilft Dir ja (in xls) "Daten" - "Externe Daten" - ("Textdatei importieren") samt Assistent weiter?
Schon ausprobiert? Alternativ vielleicht doch mal ´ne Liste und Deine Zusammenfassung uploaden - sensible Daten vorher entfernen! Wie´s geht, steht hier.

Gruß,
Frederik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8075
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 05. Dez. 2006 11:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Tag zusammen,
Marco, kennst Du den Makro-Rekorder? Schonmal ausprobiert? Mach mal, da haste dann ein (zugegeben unschönes) Grundgerüst, mit dem kannst Du dann weiterarbeiten 
Einfach den rekorder anwerfen und dann das tun, was Du sonst auch machst, und wenn Du fertig bist schaust Du Dir das Ganze im VBA-editor mal an.

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 05. Dez. 2006 13:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Bestellungen_1.zip

 
Hallo Leute,

anbei im Zip-File 4 Beispiel-Excellisten die Automatisch
aus dem CAD erstellt und auf dem Server abgelegt werden.
Diese sollen mit so wenig Aufwand wie möglich in eine Liste mit Namen:Test1.xls eingefügt werden.

Den Vorschlag mit Daten importieren habe ich getestet, bringt mich aber nicht weiter, genausowenig wie die Makroaufzeichnung
(Die Dateinamen sind immer unterschiedlich und auch haben nicht immer die gleiche Anzahl an Zeilen).

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8075
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 05. Dez. 2006 13:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

und was soll jetzt passieren?
Du lehnst Dich entspannt zurück und bekommst dann von uns die fertige Mappe zurückgesendet?

Ich denke mal, das wird nicht funktionieren ; )
Aber vielleicht erbarmt sich jemand...

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 05. Dez. 2006 14:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

@runkelruebe,

sorry wenn Du Dir auf`s Füßschen getreten fühlst.
Aber wenn du die Info von Frederik liest, wirst Du erkennen das Dieser die Daten angefragt hat:

Zitat: Alternativ vielleicht doch mal ´ne Liste und Deine Zusammenfassung uploaden - sensible Daten vorher entfernen! Wie´s geht, steht hier

Deswegen sind die Daten vorhanden und nicht um mir die Arbeit machen zu lassen.

Ich bin selbst am rumprobieren mit Makros und so habe aber leider nicht die Ahnung wie Ihr und stelle meine Fragen und wenn gewünscht lade ich auch die Beispieldatei ins Netz.

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8075
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 05. Dez. 2006 14:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Am upload selber hab ich ja nix auszusetzen, aber ich hätte erwartet, daß da mal Dein Ansatz mitdrin ist.

Sorry, das kam vielleicht zu krass rüber, aber solche Versuche hatten wir hier schon öfter.

Mal sehen, vielleicht kommt ja noch doch noch ne Lösung ; )
Nur damit ich's richtig verstehe: Du willst die Zeilen unter den Überschriften (sprich Datenzeilen) alle untereinander weg in ein NeuesBlatt haben und zwar aus jeweils allen Dateien, die sich in einem bestimmten Ordner befinden?

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 05. Dez. 2006 15:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Ich habe mit dem Makrospielen ja schon was erzeugt aber das sollte noch besser gehen.
    Workbooks.Open Filename:="C:\Test\01234-703-020.xls"
    Rows("15:15").Select
    Selection.Copy
    Windows("Test1.xls").Activate
    ActiveSheet.Paste
    Range("A16").Select
    Windows("01234-703-020.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Test\2468A-000-100.xls"
    Rows("15:15").Select
    Selection.Copy
    Windows("Test1.xls").Activate
    ActiveSheet.Paste
    Range("A17").Select
    Windows("2468A-000-100.xls").Activate
    ActiveWindow.Close
    Rows("15:24").Select
    Selection.Copy
    Windows("Test1.xls").Activate
    ActiveSheet.Paste
    Range("A27").Select

Aber so wie ich das "früher an der Unix hatte mit Listing in Textdatei umleiten, diese dann wieder abfragen, Werte von Zeile 15 bis ???(festgesetzter Wert z.B. 50) selektieren und kopieren,
ins aktive Fenster gehen und an die letzte freie Zeile anfügen, nächste öffne usw.
Die Dateinamen sind unterschiedlich und das macht das für mich nicht lösbar. Wenn ich die Files in 1-x umbenenne dann kann ich das mit Makro und Zählerschleife machen, ind das aktive Fenster einfügen und die leeren Zeilen löschen.

Mein Beispiel: (setzt vorraus das die Files immer umbenannt werden)
    ChDir "C:\Test"
    Workbooks.Open Filename:="C:\Test\1.xls"
    Rows("15:50").Select
    Selection.Copy
    Windows("Test.xls").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=11
    Range("A51").Select
    Windows("1.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Test\2.xls"
    Rows("15:50").Select
    Selection.Copy
    Windows("Test.xls").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=34
    Range("A87").Select
    Windows("2.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Test\3.xls"
    Rows("15:50").Select
    Selection.Copy
    Windows("Test.xls").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=36
    Range("A123").Select
    Windows("3.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Test\4.xls"
    Rows("15:50").Select
    Selection.Copy
    Windows("Test.xls").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-94
   
      Range("A15:P300").Select
        Selection.Sort Key1:=Range("B15"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A15").Select


Aber das geht bestimmt besser.

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Paulchen
Mitglied
Bauing./SW-Entwickler


Sehen Sie sich das Profil von Paulchen an!   Senden Sie eine Private Message an Paulchen  Schreiben Sie einen Gästebucheintrag für Paulchen

Beiträge: 1227
Registriert: 19.08.2004

Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice

erstellt am: 05. Dez. 2006 15:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Na, das ist doch immerhin ein Anfang

Schmeiß´ mal all die "ActiveWindow.SmallScroll Down:=-94" usw. ´raus, die brauchst Du nicht. Ist nur die Aktion des Scrollens, völlig unwichtig. Außerdem lässt sich "Rows("15:15").Select
    Selection.Copy" zusammenfassen zu "Rows("15:15").Copy".

Das macht den Code übersichtlicher, lesbarer, leichter verständlich.

Mir schwebt in dunkler Umnachtung eher sowas wie runkelruebes Vorschlag vor: Schleife über alle Dateien in einem (bestimmten) Ordner...

Frage: Wieviele Datensätze stehen maximal in einer der automatisch erzeugten Listen? Das sollte doch auch variabel gehalten werden, oder? In einer weiteren Schleife, solange die Mappe Datensätze enthält...

Sorry, ist vielleicht etwas theoretisch, aber für mehrt reicht´s bei mir aus Zeit- und Erfahrungsmangel nicht. Hoffe, es hilft trotzdem bei der Umsetzung.

Frederik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 05. Dez. 2006 17:20    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich


Liste.xls.txt

 
Code:
Sub herbstlese()
Dim WB As Workbook
Dim LetzteZeile As Integer

Amappe = ThisWorkbook.Name

'(in Spalte 2)
    LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)
    MsgBox "Die letzte Zeile, die einen Wert beinhaltet ist: " & LetzteZeile, vbInformation, "Is nicht wahr! :-)"

GetMappe = Application.GetOpenFilename("xls-Dateien (*.xls),*.xls", , "xls-Dateien für Dokumentation auswählen!", MultiSelect:=False)
    If TypeName(NameZiel) = "Boolean" Then
        Beep
        MsgBox "Sie müssen eine Datei auswählen!"
        Exit Sub
    End If
       
Workbooks.Open Filename:=GetMappe
   
'Kopieren
'Set cpy = Range("B15 : O15")' - ich hasse [code], der zum   =      wird - one row
Set cpy = Range("B15" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)'B15 - last row /// this will be my last exit ... :-)
    Workbooks("Liste.xls").Activate
cpy.Copy Destination:=Worksheets("Liste").Cells(LetzteZeile + 1, 2)
   
For Each WB In Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            WB.Close savechanges:=False
        End If
    Next WB
   
End Sub


wäre ein Bsp. das
A) sich die aktuelle letzte belegte Zeile merkt, eine Eingabe erfordert, B15 : O15 kopiert und das input-xls schliesst... du musst es nur mit einer weiteren Bestimmung definieren (ist sicherlich hier im Forum zu finden, das funktionierende Fragment des Codes...), wenn der zu kopierende Bereich nicht nur der Zeile 15 entsprechen soll :-)
[txt = überholt :-)]

gruss thomas *mussweiterarbeiten^^*

[thedit]B15:lastrow done ^^ so works with more then one row[theoff]

[Diese Nachricht wurde von Thomas Harmening am 05. Dez. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 05. Dez. 2006 17:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von thewolff:
Aber so wie ich das "früher an der Unix hatte mit Listing in Textdatei umleiten, diese dann wieder abfragen, Werte von Zeile 15 bis ???(festgesetzter Wert z.B. 50) selektieren und kopieren,
ins aktive Fenster gehen und an die letzte freie Zeile anfügen, nächste öffne usw.

das geht auch, so lese ich meine Nc.parts , die als Ascii vorliegen , aus
fängt dann irgendwie so an :-)
Code:
Dim iFile As Integer
    Dim sSearch As String, sTxt As String
    Call Speed 'untersub
    iFile = FreeFile
    sSearch = "B" 'Suchstring'
    sSearch2 = "VU_WERKZEUGNUMMER="
    sSearch3 = "P100="
    sSearch4 = "WKZ:"
    'sSearch5 = "AUFMASS="
    sSearch5 = "OFFSET="
    sSearch6 = "N30"
    sSearch7 = UCase(Mid(datnam, 1, 2) + Mid(datnam, 4, 4)) 'fräsnummer
    sFile = Datei
    Open sFile For Input As iFile 'Öffnet die Datei aus sFile in iFile'
    'ActiveCell.Value = Right(Left$(sFile, InStr(sFile, ".nc") - 1), 2) 'alternativ Partnummer
    Do Until EOF(1)  'Durchsucht die Datei bis EOF'
        Input #iFile, sTxt
      If InStr(sTxt, sSearch7) Then frnr = "OK"
        If InStr(sTxt, sSearch6) Then GoTo sprung 'Such nach N30 und ab nach Sprung:'
       
        If (InStr(sTxt, sSearch) And Not InStr(sTxt, "B-ACHSE")) Then 'Such nach sSearch'
            test5555 = sTxt 'Wenn String gefunden wurde, schreibt er es in aktive Zelle'
            Rem Exit Do
        End If...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 06. Dez. 2006 06:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Thomas,

danke für Deine Lösungsansätze. Ich werde diese mit meinen bestehenden
Makros verbinden und testen.

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Paulchen
Mitglied
Bauing./SW-Entwickler


Sehen Sie sich das Profil von Paulchen an!   Senden Sie eine Private Message an Paulchen  Schreiben Sie einen Gästebucheintrag für Paulchen

Beiträge: 1227
Registriert: 19.08.2004

Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice

erstellt am: 06. Dez. 2006 09:58    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Hallo,

war auch nicht untätig und habe nach Feierabend noch ein wenig gebastelt. Thomas´ Beitrag habe ich eben erst gelesen...

Anbei meine Variante. Einzige Bedingung: Die Zusammenfassung muß bei der Ausführung in einem anderen Ordner liegen als die Listen. Im "Listenordner" dürfen allerdings beliebige Dateien liegen, nur *.xls werden berücksichtigt. Leider muß der Ordner derzeit noch "händisch" eingegeben werden, siehe Quellcode.

Code:
Option Explicit

Sub ListeErstellen()
   
    Dim Datei_i
    Dim i As Integer
    Dim AlleDateien(1 To 1000) As String 'Obergrenze erforderlich!
    Dim x As Variant
    Dim Pfad As String
    Dim LetzteZeile As Integer 'Danke Thomas H.!
   
'Initialisieren des Ordners und der ersten Datei
'===Hier fehlt noch eine elegante Lösung, den Ordner auszuwählen===

    'Application.Dialogs(xlDialogOpen).Show

    Datei_i = Dir("C:\Dokumente und Einstellungen\frederik\Desktop\Bestellungen_1\")
    Pfad = ("C:\Dokumente und Einstellungen\frederik\Desktop\Bestellungen_1\")
'===***===
    i = 1
       
'Das Feld "AlleDateien" mit Dateinamen belegen; Voraussetzung: Dateien
'liegen in diesem Ordner, Prüfung auf *.xls erfolgt in Schleife
   
    Do
        If Datei_i <> "" Then
            If Right(Datei_i, 3) = "xls" Then
                AlleDateien(i) = Pfad & Datei_i
                Datei_i = Dir
                i = 1 + i
            Else: Datei_i = Dir
            End If
        End If
    Loop Until Datei_i = ""
       
'Dateien nacheinander öffnen, kopieren, schließen
   
    i = 1
    For Each x In AlleDateien
        If x <> "" Then
            LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
            Workbooks.Open Filename:=x
            WerteKopieren LetzteZeile
            i = 1 + i
        Else: Exit For
        End If
    Next x
       
End Sub

Private Function WerteKopieren(LetzteZeile) As Integer 'MUSS Werte enthalten!
   
    Dim tbl As Range
       
    ActiveSheet.Range("B15").Activate
   
    Set tbl = ActiveCell.CurrentRegion 'aus der VBA-Hilfe
        tbl.Offset(3, 0).Resize(tbl.Rows.Count - 3, tbl.Columns.Count).Copy _
        Destination:=ThisWorkbook.Sheets(1).Cells(LetzteZeile + 1, 2)
   
    ActiveWorkbook.Close False
       
End Function


Läuft unter xl 2k, am besten mal im Einzelschrittmodus (F8 in VBA) testen.

HTHHope this helps (Hoffe, es hilft weiter),
Frederik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 06. Dez. 2006 16:38    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

nachdem Frederik     ,
die Möglichkeit mehrere Dateinen nacheinander einzulesen offeriert, habe ich den 'MultiSelect:=' auf True gesetzt und eine Schleife eingebaut - und die schmutzige Variante der Mappenschliessung entfernt.

Code:
Sub herbstlese()
Dim LetzteZeile As Integer
Dim nr As Integer

WBa = ActiveWorkbook.Name

GetMappe = Application.GetOpenFilename("xls-Dateien (*.xls),*.xls", , "bitte die xls-Dateien für das Zusammenführen auswählen!", MultiSelect:=True)
    If TypeName(NameZiel) = "Boolean" Then
        Beep
        MsgBox "Sie müssen eine Datei auswählen!"
        Exit Sub
    End If
   
For nr = LBound(GetMappe) To UBound(GetMappe)
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row '(in Spalte 2)
'msgbox - nur als Hilfe
    MsgBox "Die letzte Zeile, die einen Wert beinhaltet ist: " & LetzteZeile, vbInformation, "Is nicht wahr! :-)"
Workbooks.Open Filename:=GetMappe(nr)
    WBd = ActiveWorkbook.Name

Set cpy = Range("B15:@O" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row) 'B15 bis zur letzten Zeile!
    Workbooks(WBa).Activate
        cpy.Copy Destination:=Worksheets("Liste").Cells(LetzteZeile + 1, 2) 'Kopieren
    Workbooks(WBd).Close SaveChanges:=False
Next nr
End Sub


@ entfernen -wegen dem Grapischen Smilie *grummel*

[Diese Nachricht wurde von Thomas Harmening am 06. Dez. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 09. Dez. 2006 07:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

SUPER,

danke für diese Lösung. Ihr seid die Profis.

Thema erledigt.

Schönes Wochenende

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Oberli Mike
Ehrenmitglied V.I.P. h.c.
Dipl. Maschinen Ing.



Sehen Sie sich das Profil von Oberli Mike an!   Senden Sie eine Private Message an Oberli Mike  Schreiben Sie einen Gästebucheintrag für Oberli Mike

Beiträge: 3728
Registriert: 29.09.2004

Excel 2010
128GB SSD
Windows 7

erstellt am: 16. Jan. 2007 10:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von Thomas Harmening:
und die schmutzige Variante der Mappenschliessung entfernt.

Ich nehme an, das steht im Bezug auf den Code

ActiveWorkbook.Close False

Was ist daran nicht gut?

Gruss
Mike

------------------
  The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

runkelruebe
Moderator
Straßen- / Tiefbau




Sehen Sie sich das Profil von runkelruebe an!   Senden Sie eine Private Message an runkelruebe  Schreiben Sie einen Gästebucheintrag für runkelruebe

Beiträge: 8075
Registriert: 09.03.2006

MS-Office 365 ProPlus x86
WIN7(x64)

erstellt am: 16. Jan. 2007 11:06    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Ich behaupte jetzt mal, ActiveWorkbook is nie gut, die genaue Bezeichnung ist immer vorzuziehen, speichern soll er nicht, dabei ist das SaveChanges:=False einfach sauberer geschrieben.

Aber vielleicht verrät uns der Thomas heute Abend seine gaaanz anderen Gedankengänge dabei ;-)

------------------
Gruß,
runkelruebe                         Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 16. Jan. 2007 11:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Runkelrübe 10 Points :-) & guten Abend :-)

Code:
For Each WB In Workbooks
        If WB.Name <> ThisWorkbook.Name Then
            WB.Close savechanges:=False
        End If
    Next WB
das war die schmutzige Variante, !alle Workbooks schliessen die ungleich der Aktiven sind - funktioniert, solange die Richtige aktiv ist :-)
und man wirklich nur die Aktive behalten möchte
ein !Bewusstes Schliessen mittels zuweisung der WB in eine Variable
Code:
WBd = ActiveWorkbook.Name'definieren
...dingding dong dongdong ding...Excel works
Workbooks(WBd).Close SaveChanges:=False
kann man 'sauberer' nennen:-) und man kann mehrere Mappen offen halten :-)

aber mich darf man da eigentlich nicht fragen, ich habe das programmeren nicht gelernt/nie ein Handbuch gelesen 
- ich tät' mal sagen, Hände über Kopf zusammenschlagen ist oftmals bei meinen Schnipsel angesagt   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Oberli Mike
Ehrenmitglied V.I.P. h.c.
Dipl. Maschinen Ing.



Sehen Sie sich das Profil von Oberli Mike an!   Senden Sie eine Private Message an Oberli Mike  Schreiben Sie einen Gästebucheintrag für Oberli Mike

Beiträge: 3728
Registriert: 29.09.2004

Excel 2010
128GB SSD
Windows 7

erstellt am: 16. Jan. 2007 22:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Ich verstehe, dann sind die meisten meiner Excel Makro schmutzig.
Muss ich wohl damit leben 

Danke für den Hinweis.

------------------

  The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz