Herausvorderung Datenauslesen VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

...heraussuchen und diese (aus text) importieren, wobei nach kommas getrennt wird. dann möchte soll es nach speziellen begriffen in dieser datei suchen.. zum beispiel nach "Anzahl"und in der zelle darunter den wert nehmen und in eine andere zelle einfügen. wenn das getan ist, werden die importierten daten rausgelöscht (mit range) und eine neue zeile eingefügt...

ok ..tut mir leid ..ich war wirklich viel zu ungenau ..ich versuchs nochmal ...am besten wir lassen das mit dem zip weg und konzentrieren uns auf das wichtigere ... ich habe eine reihe von ordnern(die sind ganz hinten am namen nummeriert von 1 angefangen) in jedem ordner befinden sich csv datein (in jedem ordener haben alle den gleichen namen) ..von dieses csv dateien interessiert mich jene mit dem namen "panelinfo". Wenn ich diese mit excel öffne sind die Werte nicht in tabellen geordnet, sondern einfach alles mit komma getrennt in eine zeile geschrieben. daher muss man diese in excel importieren, indem man unter daten auf externe daten abrufen und dann aus text geht..dann öffnet sich ein dialog indem man zuerst eingeben kann, das die inhalte getrennt werden sollen und dann nach welchem zeichen ..ich habe ein makro aufgezeichnet und das mal per hand gemacht ..der code der da rauskam war dieser :
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\rrt1arn2\Desktop\Ordner\Panelinfo.csv", Destination:=Range("$O$1"))
.Name = "Panelinfo"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
jetzt habe ich die csv datei in exel importiert..und die werte sind alle schön geordnet ..zum beispiel gibt es eine zelle(P1) date und darunter steht das eigentliche datum oder eine zelle time (Q1) und darunter die Zeit....leider sind die überschriften date, time usw. nicht immer in der richtigen reihenfolge...lediglich in der gleichen zeile ..daher müsste ich also schonmal in der zeile 1 nach date suchen oder nach time um darunte den wert zu bekommen den ich brauche.....diese Werte sollen dann in eine andere tabelle geschrieben werden , die auch die köpfe date, time usw hat...ob das jetzt eine andere datei ist oder die in welche die werte importiert wurden ist egal ..hauptsache die importierten daten werden nach der übertragung rausgelöscht damit platz fürs nächste ist oder es nicht zu viel wird ..denn diese prozedur müsste für alle datein mit namen panelinfo, die sich in den nummerierten ordnern befinden durchgenommen werden..also als schleife ...bis ich aus jedem ordener die wichtigen werte aus der jeweiligen panelinfo in die "endtabelle" übertragen habe
ich weiß nicht ob das mit dem importieren nötig ist aber ich denk schon weil die csv dateien sehen wenn ich sie in excel öffne so aus :
Zelle a1:Panel-ID,Date,Time,Recipe,Quality,Status,Message
Zelle a2:178012012052900722,2012-05-29,17:52:10,Universal,Quality A,OK,
Zelle a5:Panel Geometry
Zelle a6:Width,Length
Zelle a7:983.513,1652.43,
Zelle a9:Defect Summary
Zelle a10:Defekt / Defect,Ueberlauf / Overflow,Handling,Ecke / Corner,Glas Geometrie / Dimensions,Kruemmung / Warpage,Staubpartikel / Particle,Einschluss / Inclusion,Stempel,Kratzer / Scratch Cluster,Haeufungsfehler / Cummulation,Kantenfehler / Edge Cluster,Blase / Bubble Cluster,
Zelle a11:0,0,0,0,0,0,496,45,10,0,25,0,0,
wenn man die dann so wie ich geschildert habe inportiert, stehen die Zahlen von zelle a11 in spalten geordnet unter den köpfen von Zelle a10 , da ich ja nach kommas trenne und der schreibt dann alles was hinter dem komma kommt in die nächste spalte
ich hoffe es wurde klarer und ich wäre sehr sehr froh wenn mir einer helfen könnte
danke schonmal für die antworten
gruß

Sub valuesFromFilesInZIP() Dim objFSO As Object, objShApp As Object Dim strFile As String, strCSVFile As String, strPath As String Dim strTmp As String, strSearch As String Dim vntFile As Variant, vntTmp As Variant, vntRet As Variant, vntTmpPath As Variant Dim dblOut() As Double Dim lngIndex As Long Dim bolFound As Boolean Dim ff As Integer strPath = "E:\Temp\Test" 'Verzeichnis mit den ZIP-Dateien - Anpassen! strCSVFile = "info.csv" 'gesuchte Datei in den ZIP-Dateien - Anpassen! strSearch = "Anzahl" 'Suchbegriff - Anpassen! Set objShApp = CreateObject("Shell.Application") Set objFSO = CreateObject("Scripting.FileSystemObject") If Right(strPath, 1) <> "\" Then strPath = strPath & "\" vntTmpPath = strPath & Format(Now, "ZIP_yyMMdd_hhmmss") & "\" MkDir vntTmpPath vntRet = CVErr(xlErrValue) strFile = Dir(strPath & "*.zip", vbArchive) Do While strFile <> "" bolFound = False For Each vntFile In objShApp.Namespace(strPath & strFile).items If LCase(vntFile) = LCase(strCSVFile) Then objShApp.Namespace(vntTmpPath).CopyHere _ objShApp.Namespace(strPath & strFile).items.Item(CStr(vntFile)) bolFound = True Exit For End If Next If bolFound Then ff = FreeFile Open vntTmpPath & strCSVFile For Input As #ff Do While Not EOF(ff) Line Input #ff, strTmp vntTmp = Split(strTmp, ",") If IsNumeric(vntRet) Then Redim Preserve dblOut(lngIndex) dblOut(lngIndex) = CDbl(vntTmp(vntRet - 1)) lngIndex = lngIndex + 1 vntRet = CVErr(xlErrValue) Else vntRet = Application.Match(strSearch, vntTmp, 0) End If Loop Close #ff Kill vntTmpPath & strCSVFile End If strFile = Dir Loop objFSO.deletefolder Left(vntTmpPath, Len(vntTmpPath) - 1), True If lngIndex > 0 Then Range("A1").Resize(UBound(dblOut) + 1, 1) = Application.Transpose(dblOut) End If Set objFSO = Nothing Set objShApp = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Herausvorderung Datenauslesen VBA

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread