ich doch schon wieder.
Ich hoffe ich bekomme nochmal eine Hilfestellung von euch Profis.
In meinem Code berechne ich verschiedene Werte. Wenn in .Cells(raSpalte.Row, 2)
nur ein Wert gespeichert ist, rechnet er richtig. Sobald aber mehrere Werte dort
gespeichert werden bekomme ich immer eine falsche Berechnung der Werte.
Wie kann man dies abfangen? Über Msgbox gibt er mir auch 2 Werte einzeln aus wenn diese gespeichert sind. Diese müsste ich aber doch irgendwie für die Berechnung zusammenfassen, oder ?
Option Explicit
Public Sub Daten_holen_Aggregation()
Dim strPfad As String, strDatei As String
Dim raSpalte As Range
Dim wbQuelle As Workbook
Dim loSuchbegriff As Long
Dim Kostenstelle As Long
Dim KostenstelleStr As String
Dim boGefunden As Boolean
Dim loSumBewkum As Double
Dim Summe, Summe1, Summe2, Summe3, Summe4, Summe5, Summe6, Summe7, Summe8 As Double
Dim i As Long
Dim aktJahr As Long
aktJahr = Year(Now) Mod 100
'Pfad an deine Bedürfnisse anpassen
strPfad = "C:\Users\A.Harzer\Desktop\"
strDatei = "Aggregation Baustellenbewertung und Leistungsplanung_ab 2015.xlsx"
loSuchbegriff = ActiveSheet.Range("J1")
loSumBewkum = ActiveSheet.Range("I43")
Kostenstelle = CLng(Mid(loSuchbegriff, 1, 2))
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'Datei öffnen
Set wbQuelle = Workbooks.Open(strPfad & strDatei)
With wbQuelle.Worksheets("Werte für Bewertung")
' Variabel initialisieren
Summe = 0
Summe1 = 0
boGefunden = True
For i = Kostenstelle To aktJahr
KostenstelleStr = "Summe 20" & i
'Suche nach Kostenstelle in Spalte 1
Set raSpalte = .Range("A:A").Find(what:=KostenstelleStr, LookIn:=xlValues, lookat:= _
xlWhole)
'wenn gefunden dann
If Not raSpalte Is Nothing Then
'bei Fund Variable auf Wahr setzen
boGefunden = boGefunden And True
'Daten berechnen:Summe Spalte B und C in der gefundenen Zeile
'Summe1 = Summe + .Cells(raSpalte.Row, 2).Value + .Cells(raSpalte.Row, 3).Value
'Werkstattkosten
Summe1 = Summe + .Cells(raSpalte.Row, 3).Value
Summe2 = Summe1 * loSumBewkum / .Cells(raSpalte.Row, 2).Value
'MsgBox Summe1
'MsgBox Summe2
'Dieselkosten
Summe3 = Summe + .Cells(raSpalte.Row, 4).Value
Summe4 = Summe3 * loSumBewkum / .Cells(raSpalte.Row, 2).Value
'MsgBox Summe4
'Grätekosten
Summe5 = Summe + .Cells(raSpalte.Row, 5).Value
Summe6 = Summe5 * loSumBewkum / .Cells(raSpalte.Row, 2).Value
'MsgBox Summe6
'Verwaltungkosten
Summe7 = Summe + .Cells(raSpalte.Row, 6).Value
Summe8 = Summe7 * loSumBewkum / .Cells(raSpalte.Row, 2).Value
'MsgBox Summe8
Else
boGefunden = False
End If
Set raSpalte = Nothing
Next i
'Summe übertragen
ThisWorkbook.ActiveSheet.Range("A65") = Summe2
ThisWorkbook.ActiveSheet.Range("A66") = Summe4
ThisWorkbook.ActiveSheet.Range("A67") = Summe6
ThisWorkbook.ActiveSheet.Range("A68") = Summe8
End With
'Quelldatei ohne Speichern schließen
wbQuelle.Close (False)
'kein Fund - Meldung ausgeben
'If Not boGefunden Then MsgBox "Mindest eine der Kostenstellen wurde nicht gefunden."
'Variable aufräumen
Set wbQuelle = Nothing
'Bildschirmaktualisierung an
Application.ScreenUpdating = True
End Sub
DAnke vorab.Gruß
Andreas