Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Excel Makro Wert erkennen und entsprechend kopieren





Frage

Hallo, also ich beschreibe euch mein Problem. Ich habe hier in der Schule mehrere Messreihen gemacht welche in Excel gespeichert wurden und jetzt muss ich diese sortieren. Der Ordnerinhalt um den es geht sieht folgendermasen aus. data.xls a.xls aa.xls ... bf.xls ... das sind ca. 200 Dateien. Die Datei "data.xls" ist die Masterdatei, in diese sollen die Werte aus den anderen .xls Dateien jkopiert werden. Diese data.xls besteht aus 5 Tabellenblättern (Typ1; Typ2; Typ3; Typ4; Typ5) Die anderen .xls Dateien haben einen völlig beliebigen Dateinamen, aber da ich eh alle Dateien aus diesem Ordner nehmen muss ist der Dateiname ja egal denke ich. In jeder dieser xls. Dateien muss die Zelle B6 ausgelesen werden, denn sie bestimmt in welches Tabellenblatt der data.xls Datei die Werte aus dieser xls. Datei hin kopiert werden sollen. Also als Beispiel. eine beliebiege xls. Datei hat bei B6 den Wert 3. Dann sollen die Zellen C10-C15 und D10-D15 in die data.xls ins Tabellenblatt Typ3 hinenkopiert werden und untereinander aufgelistet werden. Wichtig ist noch das es nicht immer C10-C15 und D10 und D15 sind. bei Typ4 ist es C11-C16 und D11-D16. also wenn mir da jemand sagen kann wie das geht, das würde mir wirklich richtig weiterhelfen. Vielen vielen Dank

Antwort 1 von Saarbauer

Hallo,

geht grundsätzlich mit einem Makkro.

Auch ich habe hier schon mal eine Lösung dazu eingestellt, finde diese aber im Moment nicht.

Gruß

Helmut

Antwort 2 von coros

Hallo Player1987,

nachfolgendes Makro sollte das in etwa machen, was Du Dir vorgestellt hast.

Kopiere das Makro in ein StandardModul und starte das Makro "Auswertung_start" z.B. über eine Befehlsschaltfläche

Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer
Dim Summe_B2 As Variant

Const Pfad = "C:\Beispielmappen\"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B6")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("Typ1").Cells(ThisWorkbook.Sheets("Typ1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("C11:D16").Copy
ThisWorkbook.Sheets("Typ2").Cells(ThisWorkbook.Sheets("Typ2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("C12:D17").Copy
ThisWorkbook.Sheets("Typ3").Cells(ThisWorkbook.Sheets("Typ3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("C13:D18").Copy
ThisWorkbook.Sheets("Typ4").Cells(ThisWorkbook.Sheets("Typ4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("C14:D19").Copy
ThisWorkbook.Sheets("Typ5").Cells(ThisWorkbook.Sheets("Typ5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub


Mit dem Makro werden alle Dateien in einem Verzeichnis und deren Unterverzeichnissen geöffnet, der Wert aus Zelle B6 ausgelesen und die Daten entsprechend der Vorgabe in der Case-Anweisung kopiert und eingefügt.

Du musst die Bereich, die kopiert werden sollen im Makro noch anpassen. Außerdem musst Du bei der Angabe

Const Pfad = "C:\Beispielmappen\"


den Pfad, in dem sich die Dateien befinden angeben.

Ich hoffe, Du kommst klar.
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 3 von Player1987

Also habe gerade noch etwas festgestellt das ich vergessen habe.
In den einzelnen Dateien heisen die Tabellenblätter nicht Tabelle1 sondern immer wie die Detei selber. Also wenn die Datei aaaa.XLS heist dann heist das tabellenblatt aaaa.

Könntest du deinen Code so schreiben, dass du mir alles schräg schreibst was ich ändern muss, denn irgendwie klappt das noch nicht so ganz.

Antwort 4 von coros

Hallo Player1987,

alles was unterstrichen ist, muss unter Umständen angepasst werden.

Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer

Const Pfad = "C:\Beispielmappen\"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B6")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("Typ1").Cells(ThisWorkbook.Sheets("Typ1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("C11:D16").Copy
ThisWorkbook.Sheets("Typ2").Cells(ThisWorkbook.Sheets("Typ2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("C12:D17").Copy
ThisWorkbook.Sheets("Typ3").Cells(ThisWorkbook.Sheets("Typ3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("C13:D18").Copy
ThisWorkbook.Sheets("Typ4").Cells(ThisWorkbook.Sheets("Typ4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("C14:D19").Copy
ThisWorkbook.Sheets("Typ5").Cells(ThisWorkbook.Sheets("Typ5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub


Bezüglich des Blattnamens in den Dateien, die ausgelesen werden sollen. Ist dort immer nur ein Tabellenblatt enthalten oder mehrere?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von Player1987

es ist immer nur ein tabellenblatt enthalten

Antwort 6 von coros

Hallo Player1987,

dann ist der Name des Tabellenblattes egal, da das Makro sich immer am 1. Tabellenblatt orientiert und dort die Werte ausließt und kopiert.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 7 von Player1987

Ich bekomme jetzt immer den Fehler 91
und diese Zeile ist gelb hinterlegt

For Each Dateityp In Dateien.Files

Antwort 8 von Player1987

oh nein der fehler war weil es zwei makros gab. wenn ich das untere mit dem auswertung_start nehme, dann kommt kein fehler, aber er kopiert auch nichts

Antwort 9 von coros

Hallo Player1987,

stimmt der Pfad, den Du angegeben hast?


MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 10 von Player1987

ja der pfad stimmt, er macht auch irgendwas, aber er schreibt mir nix hin.

noch was anderes. werden die xls. dateien alle auf einmal geändert oder werden die wenn die werte kopiert wurden wieder geschlossen. mir wäre zweiteres lieber.

Antwort 11 von coros

Hallo Player1987,

die Dateien werden nacheinander geöffnet, der Wert aus Zelle B6 wird ausgelesen und es werden die Daten aus Spalte C und D in die Datei, aus das Makro aufgerufen wurde, in das Tabellenblatt, dessen Nummer in der auszulesenden Datei in Zelle B6 steht hineinkopiert. Danach wird die Datei wieder geschlossen.

Du kannst Dir das alles auch im VBA-Editor ansehen. Wenn Du den geöffnet hast, positioniere den Cursor irgendwo im Makro "Auswertung_start" und betätige danach für jeden Schritt die Taste F8.

Warum bei Dir nicht kopiert wird, kann ich Dir im Moment auch nicht sagen, da ich Deine Daten nicht hier vor mir habe. Besteht die Möglichkeit mir Deine Masterdatei und ein paar von den Dateien, die ausgelesen werden sollen, mal per Mail zu schicken. Dann kann ich schauen wo es klemmt. Die Mail findest Du überall auf meiner HP . Binde in der Betreffzeile irgendwie das Wort "Supportnet" und den Namen (Nickname), unter dem Du hier gepostet hast mit ein, da ich alle Mails deren Absender ich nicht kenne, ungelesen lösche.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 12 von Player1987

also ich erkläre es nochmal ganz kurz wenn in B6 der wert 3 steht, dann muss es in das tabellenblatt typ3 der data.xls kopiert werden.
wenn in B6 der Wert 4 steht, dann muss er in das Tabellenblatt Typ4 kopiert werden und halt mit den anderen entsprechend.

Aber danke schonmal so weit hat mir noch keiner geholfen

Antwort 13 von Player1987

alles klar die mail geht in 5-10 minuten an dich raus.
gruss und dnake

Antwort 14 von coros

Hallo Player1987,

das wird in dem Makro bereits realisiert, was Du schreibst. Das sind die Case-Anweisungen 1 bis 5. Wenn Du schaust, steht z.B. nach der Anweisung "Case1"

ThisWorkbook.Sheets("Typ1").Cells(ThisWorkbook.Sheets("Typ1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial


(achte auf das Unterstrichene) in der Zeile, dass die Daten in die Deine Datei in Blatt "Typ1" kopiert werden soll.

Wie bereits erwähnt, benötigt man nun sicherlich zur Findung des Problems Deine Daten.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 15 von Player1987

mail ist raus

mit folghendem betreff:

Supportnet Player1987

Gruss

Antwort 16 von coros

Hallo Player1987,

Du hattest zum Einen einen Backslash im Pfad vergessen und Du hast anstelle von B6 in der Zeile

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B15")

wie Du siehst B15 eingetragen. Daher konnte das nicht funktionieren. NAchfolgend das geänderte Makro, wie es bei mir funktioniert hat. Die fehlerhaften Stellen habe ich mal unterstrichen.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche

Option Explicit

Dim Obj As Object
Dim Dateien As Object
Dim Durchläufe As Object
Dim Dateityp As Object
Dim i As Integer
Dim j As Integer

Const Pfad = "l:\testkalib\"

Sub Auswertung_start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set Dateien = Obj.getfolder(Pfad)
Auswertung
End Sub

Sub Auswertung()
Application.ScreenUpdating = False
For Each Dateityp In Dateien.Files
If Right(Dateityp.Name, 4) = ".xls" Then
GetObject (Dateityp)

Select Case Workbooks(Dateityp.Name).Sheets(1).Range("B6")

Case 1
Workbooks(Dateityp.Name).Sheets(1).Range("C11:D16").Copy
ThisWorkbook.Sheets("1").Cells(ThisWorkbook.Sheets("1").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 2
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("2").Cells(ThisWorkbook.Sheets("2").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 3
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("3").Cells(ThisWorkbook.Sheets("3").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 4
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("4").Cells(ThisWorkbook.Sheets("4").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 5
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("5").Cells(ThisWorkbook.Sheets("5").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 6
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("6").Cells(ThisWorkbook.Sheets("6").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

Case 7
Workbooks(Dateityp.Name).Sheets(1).Range("C10:D15").Copy
ThisWorkbook.Sheets("7").Cells(ThisWorkbook.Sheets("7").Range("C65536").End(xlUp).Offset(1, 0).Row, 3).PasteSpecial

End Select
Workbooks(Dateityp.Name).Close
End If
Next
For Each Durchläufe In Dateien.subfolders
Set Dateien = Durchläufe
Auswertung
Next
End Sub



MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 17 von Player1987

Oh mein Gott.
Du hast es geschafft.
Unglaublich dieser kleine Schrägstrich war das Problem.
Das mit dem B15 war nur ein Test ob es mit einer anderen Zelle klappt.


Also DANKE DANKE DANKE

Antwort 18 von coros

Hallo Player1987,

gern geschehn. Danke auch für die Rückmeldung.

MfG,
Oliver
Jeder macht was er will, keiner macht was er soll, aber alle machen mit.

Antwort 19 von Player1987

Hi,
ich habe nochmals ein Problem.
Und zwar geht es jetzt darum.
Der AUgangspunkt ist wieder der selbe.
ca 200.txt dateien und zusätlich noch 200 csv datein´

Jeweils eine CSV Datei und eine txt datei sind zusammen in einem ordner.

Die CSV Datei hat den festen namen zusatzdaten.csv
die .txt datei hat immer die kundennummer als dateinamen und liegt auch im ordner mit der kundennummer.

ich möchte jetzt in einer neuen .xls datei in das zweite tabellenblatt in das Feld A1 eine Kundennummer eingeben und in Tabellenblatt 1 sollen sich dann die Verweise zu den Dateien ändern.
Also so z.B.
Ich gebe Kundennummer: 001 ein
Dann soll sich die Zelle A2 auf D:\MeinLaden\Daten\001\001.txt B4 beziehen. A3 auf B5 und A4 auf B6 ...bis A7.
Das ist sicherlich per Makro möglich.

Danach sollen noch werte aus der csv datei kopiert werden. Der Verwei ist nur im Ordnername variabel, die Datei heist immer Zusatzdaten.csv

Dort muss jedoch erst kurz der Text in Spalten geschrieben werden und dann wieder in mein neues Tabellenblatt muss in A8 die Zelle H1 aus Zusatzdaten.csv.


Ich denke das es am besten ist variable bezüge in die Zellen meines neuen Tabellenblatts ein zu geben, aber da weis ich leider noch nciht wie.
Zusätlich sollte das Makro natürlich die beiden entsprechenden öffnen, das die Zellen auch einen Bezug haben könnten.
Wenn das alles automatisch ablaufen würde, wäre es natürlich perfekt,
also txt und csv öffnen, csv wird der text in spalten geschrieben. werte werden aktualisiert, und die csv und txt wieder geschlossen ohne sie zu speichern (da die csv so bestehen bleiben muss).
Und danach soll dieses Blatt noch als txt gespeichert werden in einem vorgegeben ordner als dat_(Kundennummer).txt

Das wäre wunderbar wnen mir jeamnd helfen kann.

Antwort 20 von Player1987

Hi,
also ich habe alles geschafft.
nur ich habe ein problem.
ich bekomme bei meiner exportierten txt datei in manchen zeilen so hässliche gänsefüschen.
kann ich das irgendwie abstellen

Antwort 21 von coros

Hallo Player,

ich gehe mal davon aus, dass diese bereits in der Textdatei in Anführungszeichen stehen und wahrscheinlich aussagen, dass es sich um Textwerte handelt. Dann musst Du den Wert vorher mit Instr() auf diese Zeichen prüfen. Das sehe dann ungefähr so aus:

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche

Option Explicit

Sub Wandeln()
If InStr(Range("A1"), """") > 0 Then
MsgBox Mid(Range("A1"), 2, Len(Range("A1")) - 2)
Else
MsgBox Range("A1")
End If
End Sub


In diesem Beispiel wird die Zelle A1 auf die Anführungszeichen "" geprüft. Wenn Instr() einen Wert größer dem Wert 0 zurückgibt, werden durch die Mid-Funktion das 1. und letzte Zeichen herausgefiltert und hier in einer Messagebox aufgeführt. Wenn nicht, wird der ganz normale Wert aus Zelle A1 in der Messagebox aufgeführt. teste das mal. Gebe einmal "Test" und einmal nur Test, also ohne die Anführungszeichen "" ein. Du wirst dann immer den Wert Test in der Messagebox erhalten.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 22 von Player1987

Hi,
nein also in der exeldatei selber sind die anfürungszeichen nicht da.
auch wenn ich die txt datei mit dem excel öffne sind sie nicht da.
nur wenn ich die txt datei mir notepad bzw editor öffne, dann steht vor und hinter manchen zeilen ein "zahlenwert".
gibt es ne möglichkeit die "" per batch datei weg zu bekommen?
dann mässte ich das nicht in excel einbinden.
also ich möchte einfach alle "" per batch entfernen.
ist ja quasi nur suchen ersetzten und "" durch nichts ersetzen. das müsste doch eghen oder

Antwort 23 von coros

Hallo Player,

das die in Excel, wenn Du die Datei öffnest, nicht das sind ist mir schon klar. Diese Zeichen sagen mit ziemlicher Sicherheit aus, dass es sich um Textwerte handelt. Beim Öffnen der Datei in Excel werden diese Zeichen nicht mit importiert, sondern interpretieren eben, dass es sich um Textwerte handelt und formatieren die Zelle automatisch als Text. Das funktioniert aber zum Teil nicht, wenn diese Daten via Makro importiert werden. Daher mein Vorschlag mit dem Beispielmakro.

Ob das über eine Batchdatei geht, kann ich Dir nicht sagen, da DOS nicht gerade mein Spezialgebiet ist.

Frage mich nur, warum Du das nicht in VBA realisieren möchtest?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 24 von Player1987

wie muss ich den code von dir einfügen er muss es für die spalten A1 bis A28 machen.
Wäre nett danke und Gruss

Antwort 25 von coros

Hallo Player,

das würde dann wie folgt aussehen.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche

Option Explicit

Sub Wandeln()
Dim Zelle As Range
Application.ScreenUpdating = False
For Each Zelle In Range("A1:A28")
If InStr(Zelle, """") > 0 Then
Range(Zelle.Address) = Mid(Zelle, 2, Len(Zelle) - 2)
Else
Range(Zelle.Address) = Zelle
End If
Next
End Sub


Hier werden Dir im Bereich A1:A28 die Anführungszeichen gelöscht.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

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


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: