beranavan
Goto Top

Excel Dateien durchsuchen und Teile extrahieren

Hallo,

ich habe eine große Menge an Excel Dateien, die gleichermaßen aufgebaut sind:

In jeder Datei sind in Spalte A in jeder Zelle mehrere Werte durch Kommas getrennt. Jedoch brauche ich nur die Werte bis zum vierten Komma.

Gibt es eine Möglichkeit durch Makros etc. alle Dateien auf einen Schub zu bearbeiten, dass in jeder Zelle nur die Werte bis zum 4. Komma bleiben und der Rest gelöscht wird?

Ich hoffe jmd kann mir helfen,

Grüße

Content-Key: 336412

Url: https://administrator.de/contentid/336412

Ausgedruckt am: 19.03.2024 um 07:03 Uhr

Mitglied: Pjordorf
Pjordorf 28.04.2017 um 12:26:54 Uhr
Goto Top
Hallo,

Zitat von @Beranavan:
Gibt es eine Möglichkeit durch Makros etc. alle Dateien auf einen Schub
Nein, die müssen und werden eben nacheinander bearbeitet. Je mehr Dateien, je länger...

zu bearbeiten, dass in jeder Zelle nur die Werte bis zum 4. Komma bleiben und der Rest gelöscht wird?
Ja, natürlich. Per Basic, VB, VBS, VBA, Powershell, usw. oder soll / muss das als Formel sein?
Sind die Anzahl an Zeichen (inkl. Leerzeichen) bis zum 4ten Komma immer gleich oder variiert das?
Ist VBA erlaubt?
Sind die Exceldateien alle im gleichen Ordner oder gar in ein LAN fröhlich verteilt?
Was soll passieren wenn Fehler auftauchen / Dateien gesperrt sind?

Ich hoffe jmd kann mir helfen,
Schon mal den Makrorecorder deines Excel angeschmissen?

Gruß,
Peter

PS: Was ist dein Budget für Dienstleistungen? face-smile
Mitglied: Beranavan
Beranavan 28.04.2017 um 12:30:35 Uhr
Goto Top
Hallo,

Die Dateien sind alle in einem Ordner local.
Es muss nicht per Formel sein, es kann auch per Basic, VB,VBA etc. sein.
Die Anzahl der Zeichen bis zum 4. Komma variieren leider.

Ich habe leider keine Erfahrung mit dem Makrorecorder.

Grüße und danke für die schnelle Antwort.
Mitglied: colinardo
Lösung colinardo 28.04.2017, aktualisiert am 29.04.2017 um 12:54:17 Uhr
Goto Top
Servus.
Schnell als VBS zusammengeschrieben, Pfad in Zeile 2 anpassen.
On Error Resume Next
Const FOLDER = "D:\Sheets"  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set objExcel = CreateObject("Excel.Application")  
With objExcel
    .Visible = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

For Each file In fso.GetFolder(FOLDER).Files
    If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then  
        With objExcel.Workbooks.Open(file.Path).Sheets.Item(1)
            For Each cell In .Range("A1:A" & .Cells.Item(.Rows.Count,"A").End(-4162).Row)  
                If cell.Value <> "" Then  
                    arrData = Split(cell.Value,",",-1,1)  
                    If UBound(arrData) >= 2 Then
                        cell.Value = Join(Array(arrData(0),arrData(1),arrData(2)),",")  
                    End If
                End If
            Next
            .Parent.Save
            .Parent.Close
        End With
    End If
Next
With objExcel
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Quit
End With
Set fso = Nothing
Set objExcel = Nothing
MsgBox "Habe fertig",vbInformation  
Grüße Uwe
Mitglied: Beranavan
Beranavan 28.04.2017 um 14:18:39 Uhr
Goto Top
Hallo,

Danke für deine Antwort.

Ich habe ein neues Modul erstellt und diesen Code eingefügt. Wenn ich jedoch in einer meiner Dokumente es anwenden will, so wird es mir nicht angezeigt.

Wieso?

Grüße
Mitglied: colinardo
Lösung colinardo 28.04.2017 aktualisiert um 15:16:41 Uhr
Goto Top
Weil das extra als VBS Skript vorgesehen ist ohne Prozedur für das Ausführen direkt außerhalb von Excel face-smile

Du packst das in eine Textdatei mit der Endung *.vbs und passt den Ordner an und klickst doppelt auf das Skript. Du brauchst es also nicht in eine Excel-Datei packen. Das kann man auch, aber ich dachte so ist es für dich einfacher.
Es verarbeitet automatisch alle Dokumente des angegebenen Ordners.
Während der Verarbeitung siehst du nichts, erst zum Schluss wenn alle Mappen verarbeitet wurden kommt die Meldung zur Fertigstellung.
Mitglied: Beranavan
Beranavan 29.04.2017 aktualisiert um 13:19:15 Uhr
Goto Top
Hallo,

Vielen Dank für deine Antwort. Ich habe es per Excel hinbekommen und nach deiner Antwort auch als Skript face-smile

Ich habe es noch so verändert dass es passt. Jetzt macht es genau was ich will.
Jetzt habe ich aber eine andere Frage. Du hast es ja mit einem Array gelöscht. Nun möchte ich, dass es bei jeder Datei in jeder Zelle den dritten Wert,
sprich arrData(2) in einer extra Datei speichert. Also alle arrData(2) von allen Dateien sollen in einer einzigen Datei zusammengefasst werden. Falls ein Wert mehrmal vorkommt, soll es aufgezählt werden. Falls nicht, soll in der nächsten Zeile der Wert eingetragen werden.

Ist das auch mit VBS oder ähnlichem möglich?
Mitglied: colinardo
Lösung colinardo 29.04.2017 aktualisiert um 23:25:39 Uhr
Goto Top
Klar kein Problem.
Dateiname der zu erstellenden erstellte Datei in Zeile 3 eintragen.
On Error Resume Next
Const FOLDER = "D:\Daten"  
Const ABSTRACT = "D:\Daten\out\zusammenfassung.xlsx"  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set objExcel = CreateObject("Excel.Application")  
Set dic = CreateObject("scripting.dictionary")  

With objExcel
	.Visible = False
	.DisplayAlerts = False
	.ScreenUpdating = False
End With

For Each file In fso.GetFolder(FOLDER).Files
	If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then  
		With objExcel.Workbooks.Open(file.Path).Sheets.Item(1)
			For Each cell In .Range("A1:A" & .Cells.Item(.Rows.Count,"A").End(-4162).Row)  
				If cell.Value <> "" Then  
					arrData = Split(cell.Value,",",-1,1)  
					If UBound(arrData) >= 2 Then
						cell.Value = Join(Array(arrData(0),arrData(1),arrData(2)),",")  
						If dic.Exists(arrData(2)) Then
							dic.Item(arrData(2)) = dic.Item(arrData(2)) + 1
						Else
							dic.Add arrData(2),1
						End If
					End If
				End If
			Next
			.Parent.Save
			.Parent.Close
		End With
	End If
Next
keys = dic.Keys
If Not fso.FolderExists(fso.GetParentFolderName(ABSTRACT)) Then fso.CreateFolder fso.GetParentFolderName(ABSTRACT)
With objExcel.Workbooks.Add.Sheets(1)
	For i = 0 To UBound(keys)
		.Cells.Item(i+1,1).Value = keys(i)
		If dic.Item(keys(i)) > 1 Then .Cells.Item(i+1,2).Value = dic.Item(keys(i))
	Next
	.Parent.SaveAs ABSTRACT
	.Parent.Close
End With

With objExcel
	.DisplayAlerts = True
	.ScreenUpdating = True
	.Quit
End With
Set fso = Nothing
Set objExcel = Nothing
MsgBox "Habe fertig." & vbNewline & "Die Zusammenfassung finden sie unter '" & ABSTRACT &  "'.",vbInformation  
Mitglied: Beranavan
Beranavan 03.05.2017 um 15:46:05 Uhr
Goto Top
Vielen vielen Dank,

Es hat alles funktioniert mit kleinen Abänderungen.

Nun wollte ich die Listen auch noch alphabetisch sortieren lassen;

Jetzt habe ich die Fragen:

1. Wenn ich in der Liste, in der alles zusammengefasst wird, in Spalte A sortieren lasse, sollen die Werte aus Spalte B mitgenommen werden. Wie bekomme ich das hin?

2. In den anderen Listen soll alphabetisch sortiert werden, jedoch die erste Zeile soll ausgelassen werden. Diese soll immer die erste bleiben. Wenn ich bei der Sortiermethode Im Range A2 auswähle, wird immernoch die erste Zeile mit sortiert. Was mache ich falsch?

Ich hoffe jmd kann mir helfen und bedanke mich schon mal

Grüße
Mitglied: Pjordorf
Pjordorf 03.05.2017 aktualisiert um 16:23:03 Uhr
Goto Top
Hallo,

Zitat von @Beranavan:
Ich hoffe jmd kann mir helfen und bedanke mich schon mal
Excel und Daten sortieren ist keine Raketenwissenschaft.
http://tinyurl.com/mvxbcvk

Gruß,
Peter
Mitglied: colinardo
colinardo 03.05.2017 um 16:24:19 Uhr
Goto Top
Zitat von @Beranavan:
1. Wenn ich in der Liste, in der alles zusammengefasst wird, in Spalte A sortieren lasse, sollen die Werte aus Spalte B mitgenommen werden. Wie bekomme ich das hin?
Werf deinen Makrorekorder an dann siehst du wie das in VBA-Code aussieht face-wink
2. In den anderen Listen soll alphabetisch sortiert werden, jedoch die erste Zeile soll ausgelassen werden. Diese soll immer die erste bleiben. Wenn ich bei der Sortiermethode Im Range A2 auswähle, wird immernoch die erste Zeile mit sortiert. Was mache ich falsch?
s.o.
Mitglied: Beranavan
Beranavan 08.05.2017 um 12:40:37 Uhr
Goto Top
Hallo,

danke für eure Antworten. Ich hab das soweit hinbekommen, dass es in Excel sortiert wird, wie ich es möchte. Jedoch funktioniert mein Code nur im
VBA-Editor von Excel. Dort sieht mein Code so aus:

.Range("A2:A1000").Sort Key1:=.Range("A2"), Order1:=xlAscending, _  
               Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
               Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


Als Skript unter Windows funktioniert das nicht, weil VBS diesen Sortierverfahren so nicht erkennt. Im Skript hab ich des nun so umgeändert:

.Range("A2:A1000").Sort .Range("A2"), xlAscending, , , , , , xlGuess, 1, False, xlTopToBottom, , xlSortNormal  
	    'Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)  

Jedoch funktioniert es immernoch nicht. Weiß einer vllt was ich falsch mache?

Danke und Grüße
Mitglied: colinardo
Lösung colinardo 08.05.2017 aktualisiert um 13:04:55 Uhr
Goto Top
Wozu gibt's wohl den Debugger face-wink
Zum Sortieren des Ausgabesheets Im letzten Code zwischen Zeile 42 und 43 diesen einfügen:
.Range("A:B").Sort .Range("A1"),1,,,,,,0  
Den Range den du sortieren willst muss immer alle Spalten umfassen die mit sortiert werden sollen.
Mitglied: Beranavan
Beranavan 09.05.2017 um 01:07:33 Uhr
Goto Top
Danke,

das hat auch für den Ausgabesheet funktioniert. Das Problem ist bei den einzelnen Sheets, da dort die erste Zeile nicht mit sortiert werden soll;
die soll immer die erste bleiben.

Mein Code sieht nach deinem Beitrag dafür so aus, jedoch wird trotzdem die komplette Spalte sortiert:
.Range("A:B").Sort .Range("A2"),1,,,,,,0  

Und der Debugger bringt ja nix, weil im VBA-Editor funktioniert ja mein Code. Nur als Skript im VBS geht der nicht, weil der die Variablen nicht erkennt.

Danke für deine Hilfe
Mitglied: colinardo
Lösung colinardo 09.05.2017 aktualisiert um 08:15:04 Uhr
Goto Top
Hättest du mal in die Referenz geschaut, wärst du drauf gekommen das du die 0 am Ende auf 1 setzen musst, denn die steht für den Parameter Header und wenn du Überschriften hast muss dieser auf xlYes stehen was einer 1 entspricht! Im Ausgabesheet habe ich ja keine Überschriften hinzugefügt deswegen verwende ich dort eine 0 für xlNo.
Und der Debugger hilft dir schon beim Testen ohne das Skript um die Konstanten und deren Werte zu sehen, da die Konstanten in VBS nicht vorhanden sind face-wink!
Und das .Range("A2") bringt hier nichts ,A1 bleibt hier ebenfalls gleich, also nur den Header-Parameter anpassen, also:
.Range("A").Sort .Range("A1"),1,,,,,,1  
oder eben alternativ den belegten Range ohne Überschrift ermitteln und mit 0 (Header = xlNo) sortieren
.Range("A2:A" & .Cells(.Rows.Count,"A").End(-4162).Row).Sort .Range("A1"),1,,,,,,0  

Für VBS Nutzung musst du einfach nur die Parameter in ihre Values auflösen und benannte Parameter in Positionsparameter umfunktionieren da es die Konstanten in VBS nicht gibt und benannte Parameter nicht funktionieren, und dabei hilft dir der Debugger bzw. das Direkteingabefeld im VBA Editor bevor du es im VBS Codr nutzt, so einfach ist das.

So denn ich bin jetzt raus, alles andere steht in der Referenz, es ist alles gesagt face-smile.

Grüße Uwe