Excelsoftwareauswertung

Option Explicit
Option Compare Text

Private Const ExternPath = "E:\Test\Ausgabe.xls"                    'Pfad der Ausgabedatei  

Private Const HeaderLine = "Benutzer;Fehlercode;Anzahl;Prozent"     'Überschrift Zeile 1  
Private Const StartLine = 2                                         'Daten ab Zeile 2  

Private Const ErrMsg1 = "Die Ausgabedatei nicht gefunden!"  
Private Const ErrMsg2 = "Die Ausgabedatei kann nicht geöffnet werden!"  

Sub GetExternData()
    Dim oFso As Object, oWkb As Workbook, oWks As Worksheet, oUserList As Object, oKey As Variant
    Dim aValues As Variant, sUserCode As String, iNextLine As Long, iCount As Long, i As Long
    
    'Externe FileSystem-Funktionen einbinden  
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    'Prüfen ob die Ausgabedatei existiert, ansonsten Fehlermeldung ausgeben und abbrechen  
    If oFso.FileExists(ExternPath) = False Then
        MsgBox ErrMsg1, vbExclamation, "Fehler...":  Exit Sub  
    End If
    
    'Fehlerbehandlung Aus  
    On Error Resume Next
    
    'Ausgabedatei öffnen und der Object-Variablen oWkb zuweisen  
    Set oWkb = Workbooks.Open(ExternPath)
    
    'Prüfen ob die Ausgabedatei geöffnet wurde, ansonsten Fehlermeldung ausgeben und abbrechen  
    If Err Then
        MsgBox ErrMsg2, vbExclamation, "Fehler...":  Exit Sub  
    End If
    
    'Fehlerbehandlung wieder Ein  
    On Error GoTo 0
    
    'Das 1.Tabellenblatt der Ausgabedatei der Object-Variablen oWks zuweisen  
    Set oWks = oWkb.Sheets(1)
    
    'Assoziatives Array zum katalogisieren der einzelnen Benutzer mit Fehlercode und Anzahl  
    Set oUserList = CreateObject("Scripting.Dictionary")  
    'Vergleichsmethode Text (Klein/Großschreibung nicht unterscheiden)  
    oUserList.CompareMode = vbTextCompare
    
    'Die erste Zeilennummer in der Ausgabedatei-Tabelle festlegen  
    iNextLine = StartLine
    
    'Alle Zeilen in der Ausgabedatei bis zur 1. Leerzeile einlesen  
    Do While oWks.Cells(iNextLine, "A").Text <> ""  
        'Aktuelle Zeile in der Ausgabedatei bearbeiten  
        With oWks.Rows(iNextLine)
            'Nur auswerten, wenn Benutzer ist nicht TestPC und Spalte B/C enthält eine Zahl (kein Text)  
            If Not .Columns("A") Like "TestPc" And IsNumeric(.Columns("B")) And IsNumeric(.Columns("C")) Then  
                'Katalog-Schlüssel (Key) = Benutzername + Fehlercode z.B. "Computer1" + "11" = "Computer1$11"  
                sUserCode = .Columns("A") & "$" & .Columns("B")  
                'Prüfen ob Benutzer schon mit dem gleichen Fehlercode schon im Katalog existiert  
                If oUserList.Exists(sUserCode) Then  'Wenn ja, dann Katalog-Item = Aktuelle Anzahl + Anzahl  
                    oUserList.Item(sUserCode) = oUserList.Item(sUserCode) + .Columns("C")  
                Else  'Wenn nein, dann Katalog-Key + Katalog-Item (Anzahl) dem Katalog hinzufügen  
                    oUserList.Add sUserCode, CInt(.Columns("C"))  
                End If
            End If
        End With
        'Nächste Zeile in Ausgabedatei festlegen  
        iNextLine = iNextLine + 1
    Loop
    
    'Ausgabedatei nach dem Einlesen wieder schließen  
    oWkb.Close False
    
    'Gesamtsumme ermitteln (iCount)  
    For Each oKey In oUserList.Keys
        iCount = iCount + oUserList.Item(oKey)
    Next
    
    'Diese Arbeitsmappe Tabelle1 aktivieren  
    ThisWorkbook.Sheets(1).Activate

    'Zell-Inhalte löschen  
    Cells.ClearContents
    
    'Überschrift in 1. Zeile schreiben (Fett, Zentriert)  
    With Range("A1").Resize(1, 4)  
        .Font.Bold = True
        .Value = Split(HeaderLine, ";")  
        .HorizontalAlignment = xlCenter
    End With
    
    'Die erste Zeilennummer in der Auswertungstabelle festlegen  
    iNextLine = StartLine
    
    'Katalog auslesen und in die Auswertungstabelle eintragen  
    For Each oKey In oUserList.Keys
        With Rows(iNextLine)  'Aktuelle Zeile  
            aValues = Split(oKey, "$")  'Katalog-Schlüssel in Benutzer und Fehlercode aufsplitten  
            If aValues(1) <> 0 Then 'Test ob Fehlercode <> 0, wenn ja dann Eintragen  
                .Columns("A") = aValues(0)                      '=Benutzername  
                .Columns("B") = aValues(1)                      '=Fehlercode  
                .Columns("C") = oUserList.Item(oKey)            '=Anzahl  
                .Columns("D").NumberFormat = "0.00%"            '=Zellformat Prozent  
                .Columns("D") = oUserList.Item(oKey) / iCount   '=Prozent  
                iNextLine = iNextLine + 1                       'Nächste Zeile in Auswertungstabelle festlegen  
            End If
        End With
    Next
    
    'Auswertungstabelle nach Benutzername sortieren  
    Columns("A:D").Sort Key1:=Range("A2"), Header:=xlYes, MatchCase:=False  
    
    'Text mit Gesamtanmeldungen in Auswertungstabelle eintragen  
    Cells(iNextLine + 1, "A") = "Gesamtanmeldungen: " & iCount  
End Sub