Hallo zusammen,

Ich habe hier folgende Herausforderung. Ich habe zwar schon etwas, aber das ist mehr schlecht als recht adaptiert… Ist also nicht mein eigenes Ausgangsprogramm! Ich habe es nur probiert auf meine Anforderungen anzupassen…

Ich hoffe Ihr nehmt euch die Zeit, um mir zu helfen. Ich wäre euch sehr dankbar!

Anmerkung:

-         -          Wenn Beispiele benötigt werden schreibt mich bitte einfach per Mail an.

-             Ein Prüfstand legt pro Prüfung Testwerte im CSV-Format ab (siehe CSV-Datei). Es kann also von einer CSV-Datei bis 2000 CSV-Dateien alles vorkommen.

1)      1) Der Aufbau der Ordnerstruktur ist:

-          Ordner 1 –> Ordner 2 –> CSV-Datei 1,2,3 ….. n  

o   Die Auswahl des Pfads würde ich aber gerne über ein Fenster selbst vornehmen, da es eine gewisse Varianz gibt, wo die Daten abgelegt werden können.

 2) Ich benötige die folgende Werte aus einer von mir bestimmten CSV in dem Excel Dokument (In A1 bis A15),  Vorhanden ist Benennung1 bis Benennung19

):

Benennung 1

Benennung 2

Benennung 3

Benennung 4

Benennung 5

Benennung 8

Benennung 9

Benennung 10

Benennung 11

Benennung 12

Benennung 13

Benennung 14

Benennung 15

Benennung 18

Benennung 19

In A1 bis A15

2.1) dem zugeordnet: (Vorhanden ist Inhalt 1 bis Inhalt 19)

Inhalt 1

Inhalt 2

Inhalt 3

Inhalt 4

Inhalt 5

Inhalt 8

Inhalt 9

Inhalt 10

Inhalt 11

Inhalt 12

Inhalt 13

Inhalt 14

Inhalt 15

Inhalt 18

Inhalt 19

In B1 bis B15

Anmerkung: Soweit bin ich dann auch schon gekommen (siehe Anhang)

1)      3) Danach möchte ich die nächste freie Zeile mit

-          Anzahl (A16) (diese soll mitlaufen, wenn Einheit 1 daneben mit einem Wert gefüllt ist)

-          Einheit 1 (B16)

-          Einheit 2 (C17)

Benennen

Anmerkung: Das habe ich auch schon siehe Anhang

4) Den folgenden Schritt bekomme ich nicht so richtig hin… (siehe „Output – Excel“)

1)      Der letzte Schritt soll dann alle in dem ausgewählten Ordner hinterlegten CSV-Dateien auf folgenden Inhalt durchsuchen:

-          Inhalt 13 (übertragen unter Einheit 1, Spalte B)

-          Inhalt 12 (übertragen unter Einheit 2, Spalte C)

Und diese Werte dann untereinander in Reihenfolge

-          Einheit 1 (Spalte B)

-          Einheit 2 (Spalte C)

schreiben

So, ich hoffe ich habe mich deutlich ausgedrückt. Falls nicht stellt gerne Fragen!

Ich wünsche allen einen guten restlichen Tag und herzlichen Dank im Voraus!

			Hauptprogramm


'Suchen nach max. Wert in Spalte B plus Kopieren Spalte C
Sub AuswertenDerCSVmitMAX()

'21 Zeilen kopieren
Dim x As Double
Dim CSV As String
'Dim varFileToOpen As Variant

'CSV Auswertung
  Dim wksZiel As Worksheet
  Dim Zeile_Z As Long, zeile As Long
  Dim varA, dblMax, dbTemp As Double
  Dim wkbTxt As Workbook, wksTxt As Worksheet
  Dim varOrdner As Variant, varDatei As Variant
  Dim varData As Variant
  Set wksZiel = ActiveSheet
   
  '21 Zeilen kopieren

    'Ordner Suchen und den Dateipfad an die Auswertung übergeben
varDatei = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If varDatei = False Then Exit Sub
'Übergabepunkt
Open varDatei For Input As #1
'Startpunkt
x = 0
Do While Not EOF(1)
Line Input #1, CSV
Cells(1, 1).Offset(x, 0) = CSV
x = x + 1
Loop
Close #1
'alle Zeilen zählen mit Inhalt
z = Range("A4000").End(xlUp).Row
'Zeile 21 bis zur letzten löschen
Range("A21:A" & z).Delete Shift:=xlUp
'die verbleibenden 21 zeilen splitten
For j = 1 To 21
Text = Split(Cells(j, 1), ";")
For i = 0 To UBound(Text)
Cells(j, i + 1) = Text(i)
Next
Next


'######################################################################################################################


'Formatieren der Tabelle
Call LöschenSpaltenZellen


'######################################################################################################################
  
  
'Bereich für die Auswertung der CSV Dateien
  
  With wksZiel
    'letteZeile in Spalte A mit Inhalt
    Zeile_Z = .Cells(.Rows.Count, 2).End(xlUp).Row 'Sucht in Spalte B den letzten Eintrag und schreibt den nächsten Eintrag direkt darüber
  End With
  
  'Ordner auswählen
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Bitte den Ordner mit den csv-Dateien auswählen"
    
    If .Show = -1 Then
      varOrdner = .SelectedItems(1)
    Else
      GoTo Beenden
    End If
  End With
  
  Application.ScreenUpdating = False
  
  'csv-Dateien suchen
  varDatei = Dir(varOrdner & "\*.csv")
  Do Until varDatei = ""
    'csv öffnen - 1000er- und Dezimal-Trennzeichen anpassen, Local auf False _
      setzen wenn Daten nicht mit den lokalen Einstellungen der Systemsteuerung übereinstimmen.
    Application.Workbooks.OpenText Filename:=varOrdner & "\" & varDatei, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Tab:=False, semicolon:=True, comma:=False, _
        Space:=True, other:=False, ThousandsSeparator:=".", DecimalSeparator:=",", _
        Local:=True
    Set wkbTxt = ActiveWorkbook
    Set wksTxt = wkbTxt.Sheets(1)
    
    'Daten in SpaltenA und B in eine Daten-Array schreiben - Auswertung geht dann schneller.
    With wksTxt
      varData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2)) 'Bei Offset(Spalte, Zeile) hier überträgt er in dieser Konfi Druck [B] und Temperatur [C]
    End With
    
    'Werte für Spalte A und B zurücksetzen
    varA = "no Data"
    dblMax = -99999
    
    
   If UBound(varData, 1) >= 21 Then      'Sucht ab Zeile 21 Spalte A bis zur letzten Zelle mit Inhalt
   
      varA = varData(21, 1) 'nicht benötigt in der Auswertung
      dblMax = varData(21, 2) 'Einheit 1
      dbTemp = varData(21, 3) 'Einheit 2
      
      For zeile = 21 To UBound(varData, 1)
        If IsNumeric(varData(zeile, 1)) Then
        If varData(zeile, 1) > dblMax Then
          varA = varData(zeile, 1)
          dblMax = varData(zeile, 2)
          dbTemp = varData(21, 3) 'Temperatur
        End If
        End If
      Next
      
    End If
    
    'text-Datei ohne speichern wieder schliesen
    wkbTxt.Close SaveChanges:=False
    
    'daten-Array löschen
    Erase varData
    
    'gefundenen Werte in Zieltabelle eintragen
    With wksZiel
      Zeile_Z = Zeile_Z + 1 'Abstand für neuen Eintrag zum letzten Eintrag; 1= nächste Zeile, 2= eine Leerzeile
          .Cells(Zeile_Z, 2) = dblMax 'Einheit 1
           .Cells(Zeile_Z, 3) = dbTemp 'Einheit 2
    End With
    'nächste datei suchen
    varDatei = Dir
  Loop
Beenden:
  Application.ScreenUpdating = True
  
  
  
  '##############################################################################################################################################################################################
  
  
  'Anzahl der Tests Aufführen
  Call Nummerierung
  'Zellen Formatieren
Call ZahlenFormatEinstellen

    
    
   '##############################################################################################################################################################################################
    
End Sub



Nebenprogramme 

1)
Sub LöschenSpaltenZellen()
With Worksheets("Tabelle1")
'STUFE 1 Inhalte entfernen
'Nr. tauschen und Platzhalter löschen
Range("A20").ClearContents
Range("A21").Value = "Nr." ' Spalte A
Range("B20").ClearContents
Range("B21").Value = "Einheit 1" 'hier Einheit 1 in die entsprechende Zelle eintragen (Spalte B)
Range("C20").ClearContents
Range("C21").Value = "Einheit 2" 'hier Einheit 2 in die entsprechende Zelle eintragen (Spalte C)
Range("C1:C19").ClearContents
'Löscht überflüssige Zeilen aus CSV-Datei
Range("6:6,7:7,9:9,10:10,11:11,16:16").Select
Selection.Delete
End With
End Sub

2) 

Sub Nummerierung()
  Dim i As Long, n As Long
  n = 1
  With Sheets("Tabelle1")
    For i = 16 To .Cells(Rows.Count, "B").End(xlUp).Row
      If .Cells(i, "B") <> "" Then
        .Cells(i, "A") = n
        n = n + 1
      End If
    Next
  End With
End Sub