Von Copy-Paste zur Excel-Automation

AnhörenAudio: Von Copy-Paste zur Excel-Automation

Ausgangslage

Manche Prozesse sind nicht groß genug für ein eigenes Softwareprojekt – aber nervig genug, um jedes Jahr wieder Zeit zu kosten.

Ein Beispiel: die Zusammenfassung meiner Fahrten für die Steuererklärung.

Bisher war der Ablauf ziemlich banal: Strecke heraussuchen, Entfernung kopieren, in Excel eintragen, wiederholen. Für einzelne Fahrten kein Problem. Bei vielen wiederkehrenden Strecken wird daraus aber schnell ein klassischer Copy-Paste-Prozess: monoton, fehleranfällig und schlicht unnötig.

Also habe ich mir eine kleine Excel-Vorlage gebaut und mit einer Automation mittels Makro ausgestattet.

Die Idee

Startadresse und Zieladresse eintragen, Makro ausführen, Entfernung automatisch berechnen lassen. Unterstützt wurde ich dabei von ChatGPT – nicht als fertiger Softwareentwickler, sondern als Sparringspartner beim Debugging, Strukturieren und Anpassen des Codes.

Umsetzung

Aus der ersten einfachen Formel wurde Schritt für Schritt eine robustere Lösung:

Excel-Vorlage mit Makros
Anbindung an die Google Routes API
automatische Berechnung der Entfernung
Cache für wiederkehrende Strecken
feste Werte statt ständig neu berechneter Formeln

Kostenoptimierung durch Caching

Gerade der Cache ist der entscheidende Punkt. Wenn eine Strecke einmal berechnet wurde, wird sie lokal in einem eigenen Tabellenblatt gespeichert. Taucht dieselbe Verbindung später erneut auf, muss sie nicht noch einmal über die API abgefragt werden, sondern direkt aus dem Cache gelesen.

Das spart nicht nur Zeit, sondern auch Kosten, reduziert unnötige Abhängigkeit von externen Diensten und senkt potenzielle Kosten.

Gleichzeitig macht es die Datei robuster: Bereits berechnete Werte bleiben erhalten und müssen nicht bei jeder Änderung der Excel-Datei neu erzeugt werden.

Das Ergebnis ist kein großes Produkt. Kein Dashboard. Kein komplexes System. Sondern ein kleines Werkzeug, das genau ein Problem löst:

Wiederkehrende Fahrten schneller, sauberer und nachvollziehbarer dokumentieren.

Der eigentliche Nutzen

Der eigentliche Nutzen liegt dabei nicht nur in der gesparten Zeit. Sondern darin, dass aus einem manuellen Arbeitsschritt ein wiederverwendbarer Prozess wurde.

Einmal eingerichtet, kann die Vorlage jedes Jahr erneut verwendet werden.

Für mich ist genau das der Kern sinnvoller Automatisierung: Nicht alles neu erfinden. Nicht jeden Prozess übertechnisieren. Sondern dort ansetzen, wo Arbeit immer wieder gleich abläuft – und daraus ein kleines System bauen, das entlastet.

Fazit

KI war dabei nicht die Lösung selbst. Sie war der Beschleuniger.

Die Lösung entstand aus dem Zusammenspiel von Prozessverständnis, technischem Grundaufbau und gezielter Unterstützung beim Umsetzen.

Oder einfacher gesagt:

Weniger Copy-Paste. Mehr System!

VBA-Code

Nachfolgender Code wurde als VBA-Modul verwendet. Dieser ist optimiert auf MacOS, da unter MacOS kein ActiveX verfügbar ist. Der API-Aufruf erfolgt deshlab über curl.

Sicherheitshinweis

Im Code ist der API-Key bewusst als Platzhalter angegeben. Ein echter API-Key sollte niemals öffentlich in einem Blogartikel, Repository oder Screenshot landen. Außerdem sollte der Schlüssel in der Google Cloud Console auf die benötigte API eingeschränkt und mit Budgets beziehungsweise Quotas abgesichert werden.

VBA-Code anzeigen

Option Explicit

Private Const API_KEY As String = "YOUR_API_KEY_HERE"
Private Const CACHE_SHEET As String = "Cache"

' ============================================================
' Hauptmakro:
' Berechnet fehlende Kilometer in Spalte E
' Grundlage:
'   C = Start
'   D = Ziel
'   E = Kilometer
' ============================================================
Public Sub UPDATE_DISTANCES()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim origin As String
    Dim destination As String
    Dim km As Double
    
    Set ws = ActiveSheet
    
    EnsureCacheSheet
    
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    For r = 2 To lastRow
        origin = Trim(ws.Cells(r, "C").value)
        destination = Trim(ws.Cells(r, "D").value)
        
        If origin <> "" And destination <> "" Then
            
            ' Nur berechnen, wenn km-Zelle leer ist
            If Trim(ws.Cells(r, "E").value) = "" Then
                
                km = GetDistanceWithCache(origin, destination)
                
                If km > 0 Then
                    ws.Cells(r, "E").value = Round(km, 1)
                Else
                    ws.Cells(r, "E").value = "FEHLER"
                End If
                
            End If
            
        End If
    Next r
    
    MsgBox "Distanzen wurden aktualisiert.", vbInformation
End Sub


' ============================================================
' Optional weiterhin als Formel nutzbar:
' =GET_DISTANCE(C2;D2)
'
' Hinweis:
' Diese Funktion nutzt den Cache, schreibt ihn aber nicht zuverlässig
' in die Tabelle. Für produktive Nutzung besser UPDATE_DISTANCES verwenden.
' ============================================================
Public Function GET_DISTANCE(origin As String, destination As String) As Double
    If Trim(origin) = "" Or Trim(destination) = "" Then
        GET_DISTANCE = 0
        Exit Function
    End If
    
    GET_DISTANCE = GetDistanceWithCache(origin, destination)
End Function


' ============================================================
' Cache-Logik
' ============================================================
Private Function GetDistanceWithCache(origin As String, destination As String) As Double
    Dim cachedKm As Double
    Dim apiKm As Double
    
    cachedKm = GetCachedDistance(origin, destination)
    
    If cachedKm > 0 Then
        GetDistanceWithCache = cachedKm
        Exit Function
    End If
    
    apiKm = GetDistanceFromRoutesApi(origin, destination)
    
    If apiKm > 0 Then
        SaveDistanceToCache origin, destination, apiKm
    End If
    
    GetDistanceWithCache = apiKm
End Function


Private Function GetCachedDistance(origin As String, destination As String) As Double
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim key As String
    
    EnsureCacheSheet
    
    Set ws = ThisWorkbook.Worksheets(CACHE_SHEET)
    key = BuildCacheKey(origin, destination)
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For r = 2 To lastRow
        If ws.Cells(r, "A").value = key Then
            GetCachedDistance = CDbl(ws.Cells(r, "D").value)
            Exit Function
        End If
    Next r
    
    GetCachedDistance = 0
End Function


Private Sub SaveDistanceToCache(origin As String, destination As String, km As Double)
    Dim ws As Worksheet
    Dim nextRow As Long
    
    EnsureCacheSheet
    
    Set ws = ThisWorkbook.Worksheets(CACHE_SHEET)
    
    nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ws.Cells(nextRow, "A").value = BuildCacheKey(origin, destination)
    ws.Cells(nextRow, "B").value = origin
    ws.Cells(nextRow, "C").value = destination
    ws.Cells(nextRow, "D").value = Round(km, 3)
    ws.Cells(nextRow, "E").value = Now
End Sub


Private Sub EnsureCacheSheet()
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(CACHE_SHEET)
    On Error GoTo 0
    
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add
        ws.Name = CACHE_SHEET
        
        ws.Cells(1, "A").value = "cache_key"
        ws.Cells(1, "B").value = "origin"
        ws.Cells(1, "C").value = "destination"
        ws.Cells(1, "D").value = "km"
        ws.Cells(1, "E").value = "created_at"
    End If
End Sub


Private Function BuildCacheKey(origin As String, destination As String) As String
    BuildCacheKey = NormalizeText(origin) & " -> " & NormalizeText(destination)
End Function


Private Function NormalizeText(value As String) As String
    value = LCase(Trim(value))
    value = Replace(value, vbTab, " ")
    
    Do While InStr(value, "  ") > 0
        value = Replace(value, "  ", " ")
    Loop
    
    NormalizeText = value
End Function


' ============================================================
' Google Routes API: Compute Route Matrix
' ============================================================
Private Function GetDistanceFromRoutesApi(origin As String, destination As String) As Double
    Dim url As String
    Dim body As String
    Dim response As String
    Dim bodyFile As String
    Dim responseFile As String
    Dim shellCommand As String
    Dim distanceMeters As Double
    
    url = "https://routes.googleapis.com/distanceMatrix/v2:computeRouteMatrix"
    
    body = "{""origins"":[{""waypoint"":{""address"":""" & JsonEscape(origin) & """}}]," & _
           """destinations"":[{""waypoint"":{""address"":""" & JsonEscape(destination) & """}}]," & _
           """travelMode"":""DRIVE""," & _
           """routingPreference"":""TRAFFIC_UNAWARE""," & _
           """languageCode"":""de-DE""," & _
           """units"":""METRIC""}"
    
    bodyFile = Environ$("TMPDIR") & "routes_body.json"
    responseFile = Environ$("TMPDIR") & "routes_response.json"
    
    WriteTextFile bodyFile, body
    
    shellCommand = "curl -s -X POST " & ShellQuote(url) & _
                   " -H " & ShellQuote("Content-Type: application/json") & _
                   " -H " & ShellQuote("X-Goog-Api-Key: " & API_KEY) & _
                   " -H " & ShellQuote("X-Goog-FieldMask: originIndex,destinationIndex,status,condition,distanceMeters,duration") & _
                   " --data-binary @" & ShellQuote(bodyFile) & _
                   " -o " & ShellQuote(responseFile)
    
    RunShellCommand shellCommand
    
    response = ReadTextFile(responseFile)
    
    If InStr(response, """distanceMeters""") = 0 Then
        Debug.Print "Keine distanceMeters gefunden:"
        Debug.Print response
        GetDistanceFromRoutesApi = 0
        Exit Function
    End If
    
    distanceMeters = ExtractNumberAfterKey(response, "distanceMeters")
    
    If distanceMeters > 0 Then
        GetDistanceFromRoutesApi = distanceMeters / 1000
    Else
        GetDistanceFromRoutesApi = 0
    End If
End Function


' ============================================================
' Hilfsfunktionen
' ============================================================
Private Function ExtractNumberAfterKey(json As String, key As String) As Double
    Dim keyPos As Long
    Dim colonPos As Long
    Dim i As Long
    Dim ch As String
    Dim num As String
    
    keyPos = InStr(json, """" & key & """")
    
    If keyPos = 0 Then
        ExtractNumberAfterKey = 0
        Exit Function
    End If
    
    colonPos = InStr(keyPos, json, ":")
    
    If colonPos = 0 Then
        ExtractNumberAfterKey = 0
        Exit Function
    End If
    
    For i = colonPos + 1 To Len(json)
        ch = Mid(json, i, 1)
        
        If ch Like "[0-9.]" Then
            num = num & ch
        ElseIf num <> "" Then
            Exit For
        End If
    Next i
    
    If num <> "" Then
        ExtractNumberAfterKey = CDbl(num)
    Else
        ExtractNumberAfterKey = 0
    End If
End Function


Private Function JsonEscape(value As String) As String
    value = Replace(value, "\", "\\")
    value = Replace(value, """", "\""")
    value = Replace(value, vbCrLf, " ")
    value = Replace(value, vbCr, " ")
    value = Replace(value, vbLf, " ")
    
    JsonEscape = value
End Function

Private Sub WriteTextFile(filePath As String, content As String)
    Dim fileNumber As Integer
    
    fileNumber = FreeFile
    
    Open filePath For Output As #fileNumber
    Print #fileNumber, content
    Close #fileNumber
End Sub


Private Function ReadTextFile(filePath As String) As String
    Dim fileNumber As Integer
    Dim content As String
    Dim lineText As String
    
    fileNumber = FreeFile
    
    Open filePath For Input As #fileNumber
    
    Do Until EOF(fileNumber)
        Line Input #fileNumber, lineText
        content = content & lineText & vbLf
    Loop
    
    Close #fileNumber
    
    ReadTextFile = content
End Function


Private Function ShellQuote(value As String) As String
    ShellQuote = "'" & Replace(value, "'", "'\''") & "'"
End Function


Private Sub RunShellCommand(command As String)
    MacScript "do shell script " & AppleScriptQuote(command)
End Sub


Private Function AppleScriptQuote(value As String) As String
    AppleScriptQuote = """" & Replace(value, """", "\""") & """"
End Function

Public Sub TEST_DISTANCE()
    Dim km As Double
    
    km = GetDistanceWithCache("Münster Hauptbahnhof", "Düsseldorf Hauptbahnhof")
    
    MsgBox "Distanz: " & Round(km, 1) & " km"
End Sub

Was suchst du?