Formel in VBA umschreiben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Alles klar. Ich versuche so präzis wie möglich zu sein und beziehe mich auf die raufgeladene Datei:
Zuerst eine kurze Einleitung um was es geht:
Im Tabellenblatt Mainlist stehen Kosten pro Kostenstelle. Ich möchte diese Kosten auf Kunden aufteilen. (eine Zeile im Tabellenblatt ist ein Kunde). Dafür werden die Kosten der entsprechenden Kostenstelle genommen und durch die Summe der Umsätze aller Kunden aus dem selben Bereich geteilt. Die idee ist, dass wenn ein Bereich mehr umsatz gemacht hat, braucht er auch mehr Kosten zu tragen.
So, und jetzt noch etwas technischer:
1. Prüfung ob meine Kostenstelle (Stammdaten!B5) aus den Stammdaten auch in der Tabelle Mainlist (Spalte B) vorhanden ist.
2. Falls meine Kostenstelle da nicht vorhanden ist möchte ich einfach eine "KST nicht vorhandn" ausweisen. (das ist der einfachste Fall)
3. Falls meine Kostenstelle nun aber vorhanden ist dann soll er den Kostenbetrag (Mainlist!C:C) nehmen, (natürlich der, der zur kostenstelle passt) und diesen Durch die Summe teilen.
Bei der Summe handelt es sich um die Summe von Umstätzen aus der Spalte B in im Tabellenblatt Tabelle1. Wie oben beschrieben ist es aber nicht die totale Summen aller Bereiche, sonder nur die Summe des Bereichs, zu dem der Kunde auch angehört.
Ich hoffe das war klar genug. falls nicht, natürlich einfach nachfragen, dann werde ich präzisieren.
So wie ich bis jetzt gelesen habe, könnte man warscheinlich zuerst mit "if" arbeiten und dann cases definieren (für die einzelnen Bereiche) und abhängig von dem dann die Summe ziehen. Aber wie gesagt bin ich leider noch Anfänger.
Dann noch zwei Details. Die Berechnung sollte für alle Zellen in der Spalte C im Tabellenblatt "Tabelle1" ausgeführt werden, für die es in der Spalte A Werte hat. Eine Schwierigkeit könnte noch sein, dass die Kostenstelle noch mit Text rundherum in der Tabelle Mainlist stehen wird.
Jetzt schonmal Danke Vielmals, dass ich nicht abgewiesen wurde, mit dem doch beträchtlichen "Hilfe-Aufwand" eurerseits.
Gruss
Rainer

Hi Rainer,
ich hoffe, dass ich alles richtig umgesetzt habe


Sub kostenstelle_feststellen()
Dim raZelleMain As Range
Dim raZelleTab1 As Range
Dim loLetzteMain As Long
Dim loLetzteStamm As Long
Dim loLetzteTab1 As Long
Dim loZeileStamm As Long
Dim loZeileTab1 As Long
Dim doQuotient As Double
Dim strAdrTab1 As String
Dim wsMain As Worksheet
Dim wsTab1 As Worksheet
Set wsMain = Worksheets("Mainlist")
Set wsTab1 = Worksheets("Tabelle1")
loLetzteMain = IIf(IsEmpty(wsMain.Cells(wsMain.Rows.Count, 2)), wsMain.Cells(wsMain.Rows. _
Count, 2).End(xlUp).Row, wsMain.Rows.Count)
loLetzteTab1 = IIf(IsEmpty(wsTab1.Cells(wsTab1.Rows.Count, 2)), wsTab1.Cells(wsTab1.Rows. _
Count, 2).End(xlUp).Row, wsTab1.Rows.Count)
Application.ScreenUpdating = False
With Worksheets("Stammdaten")
loLetzteStamm = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp). _
Row, .Rows.Count)
For loZeileStamm = 5 To loLetzteStamm
Set raZelleMain = wsMain.Range("B2:B" & loLetzteMain).Find(.Cells(loZeileStamm, 2),  _
lookat:=xlPart)
If Not raZelleMain Is Nothing Then
If Application.WorksheetFunction.SumIf(wsTab1.Range("A2:A" & loLetzteTab1), . _
Cells(loZeileStamm, 4), wsTab1.Range("B2:B" & loLetzteTab1))  0 Then
doQuotient = raZelleMain.Offset(0, 1) / Application.WorksheetFunction.SumIf( _
wsTab1.Range("A2:A" & loLetzteTab1), .Cells(loZeileStamm, 4), wsTab1.Range("B2:B" & loLetzteTab1))
Else
doQuotient = 0
End If
For loZeileTab1 = 2 To loLetzteTab1
Set raZelleTab1 = wsTab1.Range("A1:A" & loLetzteTab1).Find(.Cells( _
loZeileStamm, 4), lookat:=xlWhole)
If Not raZelleTab1 Is Nothing Then
strAdrTab1 = raZelleTab1.Address
Do
raZelleTab1.Offset(0, 2) = doQuotient
Set raZelleTab1 = wsTab1.Range("A1:A" & loLetzteTab1).FindNext( _
raZelleTab1)
Loop While Not raZelleTab1 Is Nothing And raZelleTab1.Address   _
strAdrTab1
End If
Next loZeileTab1
Else
MsgBox "Kostenstelle " & .Cells(loZeileStamm, 2) & " in Tabelle 'Mainlist'  _
nicht gefunden"
End If
Next loZeileStamm
End With
Application.ScreenUpdating = True
End Sub

Bis später,
Karin

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Formel in VBA umschreiben

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread