Registriert seit: 08.02.2017
Version(en): 2016
22.11.2018, 08:34
(Dieser Beitrag wurde zuletzt bearbeitet: 22.11.2018, 08:35 von dertommy.)
Hallo!
Ich habe folgendes Problem. Ich habe eine Formel, welche ich mittels VBA in eine bestimmte Zelle schreibe. Nur schaffe ich es nicht, diese Formel mit einer geschwungenen Klammer vorne und hinten zu erzeugen.
Hier einmal der Code:
Code: .Cells(q, 24).FormulaR1C1 = "=IF(COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"")=1,""Auszahlung: "" & COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"") & "" am "" & TEXT(MAX(IF(Auszahlungen!C[-23]=""" & strFind & """,Auszahlungen!C[-16])),""TT.MM.JJJJ"") & "" in Höhe von € ""&TEXT(SUMIFS(Auszahlungen!C[-20],Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgez" & _
"ahlt""),""#.##0,00""), ""Auszahlungen: "" & COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"")&"" in Höhe von € ""&TEXT(SUMIFS(Auszahlungen!C[-20],Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt""),""#.##0,00"")&"""")" & _
""
Kann mir bitte vielleicht jemand helfen, wie der Code aussehen soll, so dass geschwungene Klammer erzeugt werden?
Danke und
LG
Thomas
Excel Version 2016
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
22.11.2018, 08:49
(Dieser Beitrag wurde zuletzt bearbeitet: 22.11.2018, 08:50 von LCohen.)
.FormulaArray statt .FormulaR1C1
Alternativ kann man in vielen Fällen ein INDEX einschleusen und darauf verzichten.
Registriert seit: 08.02.2017
Version(en): 2016
Hallo!
Funktioniert leider nicht, es kommt folgende Fehlermeldung:
Laufzeitfehler '1004':
Die FormulaArray-Eigenschaft des Range-Objektes kann nicht festgelegt werden.
Kannst du mir bitte vielleicht noch einmal weiterhelfen? Anbei der ganze Code von dem Tabellenblatt:
Code: Private Sub Worksheet_Change(ByVal Target As Range) 'Wenn etwas geändert wird
If Target.Column = 4 Then
If Not IsEmpty(Cells(Target.Row, 1)) Then
Sheets("Auszahlungen").Activate
x = Range("A65536").End(xlUp).Row
Cells(x + 0, 7).Select
Exit Sub
End If
End If
If Target.Column = 7 Then 'in Spalte G
If ActiveSheet.Cells(Target.Row, 1).Value <> vbNullString Then 'und Spalte A nicht leer ist
With ThisWorkbook.Worksheets("Auszahlungen")
strFind = ActiveSheet.Cells(Target.Row, 1).Value
End With
With ThisWorkbook.Worksheets("Top30")
Set rngFind = ThisWorkbook.Worksheets("Top30").Columns(2).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte B
Set rngFind2 = ThisWorkbook.Worksheets("Top30").Columns(7).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte G
Set rngFind3 = ThisWorkbook.Worksheets("Top30").Columns(12).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte L
Set rngFind4 = ThisWorkbook.Worksheets("Top30").Columns(17).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte Q
Set rngFind8 = ThisWorkbook.Worksheets("Top30").Columns(20).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte T
Set rngFind9 = ThisWorkbook.Worksheets("Top30").Columns(22).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte W
If Not rngFind Is Nothing Then 'Wenn Wert existiert dann
RangnachBeträgeneu = .Cells(rngFind.Row, 1)
RangnachmeistenAuszahlungenneu = .Cells(rngFind2.Row, 6)
RangnachderHäufigkeitneu = .Cells(rngFind3.Row, 11)
RangnachBeträgealt = .Cells(rngFind4.Row, 16)
DatumderletztenAuszahlung = .Cells(rngFind4.Row, 18)
RangnachmeistenAuszahlungenalt = .Cells(rngFind8.Row, 19)
RangnachderHäufigkeitalt = .Cells(rngFind9.Row, 21)
ThisWorkbook.Worksheets("Top30").Activate
Top30alleanzeigen
Top30anzeigen
ThisWorkbook.Worksheets("Auszahlungen").Activate
With ThisWorkbook.Worksheets("Auszahlungen")
.Cells(Target.Row, 8) = Date
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
If RangnachBeträgeneu < RangnachBeträgealt And RangnachmeistenAuszahlungenneu >= RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu >= RangnachderHäufigkeitalt Then
MsgBox "Folgende neue Rangordnung hat sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & " (alt: " & RangnachBeträgealt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnungen haben sich nicht verändert: " & String(2, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu >= RangnachBeträgealt And RangnachmeistenAuszahlungenneu < RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu >= RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnung hat sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & " (alt: " & RangnachmeistenAuszahlungenalt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnungen haben sich nicht verändert: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu >= RangnachBeträgealt And RangnachmeistenAuszahlungenneu >= RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu < RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnung hat sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & " (alt: " & RangnachderHäufigkeitalt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnungen haben sich nicht verändert: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & String(1, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu < RangnachBeträgealt And RangnachmeistenAuszahlungenneu < RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu < RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnungen haben sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & " (alt: " & RangnachBeträgealt & ")" & String(1, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & " (alt: " & RangnachmeistenAuszahlungenalt & ")" & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & " (alt: " & RangnachderHäufigkeitalt & ")" & String(1, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu >= RangnachBeträgealt And RangnachmeistenAuszahlungenneu >= RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu >= RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende Rangordnungen gibt es bei """ & Target.Offset(0, -6).Value & """:" & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & String(1, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & String(2, vbNewLine) & _
"Seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " hat sich bei den Rangordnungen nichts verändert." & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu < RangnachBeträgealt And RangnachmeistenAuszahlungenneu < RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu >= RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnungen haben sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & " (alt: " & RangnachBeträgealt & ")" & String(1, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & " (alt: " & RangnachmeistenAuszahlungenalt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnung hat sich nicht verändert: " & String(2, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu < RangnachBeträgealt And RangnachmeistenAuszahlungenneu >= RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu < RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnungen haben sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & " (alt: " & RangnachBeträgealt & ")" & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & " (alt: " & RangnachderHäufigkeitalt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnung hat sich nicht verändert: " & String(2, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
Else
If RangnachBeträgeneu >= RangnachBeträgealt And RangnachmeistenAuszahlungenneu < RangnachmeistenAuszahlungenalt And RangnachderHäufigkeitneu < RangnachderHäufigkeitalt Then
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende neue Rangordnungen haben sich bei """ & Target.Offset(0, -6).Value & """ seit der letzten Auszahlung vom " & DatumderletztenAuszahlung & " ergeben: " & String(2, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenneu & " (alt: " & RangnachmeistenAuszahlungenalt & ")" & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeitneu & " (alt: " & RangnachderHäufigkeitalt & ")" & String(2, vbNewLine) & _
"Folgende Rangordnung hat sich nicht verändert: " & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgeneu & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
End If
End If
End If
End If
End If
End If
End If
End If
End With
With ThisWorkbook.Worksheets("Top30")
.Cells(rngFind4.Row, 18).FormulaR1C1 = Date
Top30aktualisieren
End With
Else 'sonst
With ThisWorkbook.Worksheets("Top30")
q = .Cells(6, 1).CurrentRegion.Rows.Count + 6
.Cells(q, 1).FormulaR1C1 = "=RANK(RC[2],C[2])"
.Cells(q, 2).FormulaR1C1 = "=""" & strFind & " (""&COUNTIFS(Auszahlungen!C[-1],""" & strFind & """,Auszahlungen!C[4],""ausgezahlt"")& ""x)"""
.Cells(q, 3).FormulaR1C1 = "=SUMIFS(Auszahlungen!C[1],Auszahlungen!C[-2],""" & strFind & """,Auszahlungen!C[3],""ausgezahlt"")"
.Cells(q, 4).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(IFERROR(LEFT(RC[-2],SEARCH("" "",RC[-2],1) -1),RC[-2]),Panels!C[-2],1,0)),""nicht aktiv"",""aktiv"")"
.Cells(q, 6).FormulaR1C1 = "=RANK(RC[2],C[2])"
.Cells(q, 7).FormulaR1C1 = "=""" & strFind & " (€ ""&TEXT(SUMIFS(Auszahlungen!C[-3],Auszahlungen!C[-6],""" & strFind & """,Auszahlungen!C[-1],""ausgezahlt""),""#.##0,00"") & "")"""
.Cells(q, 8).FormulaR1C1 = "=COUNTIFS(Auszahlungen!C[-7],""" & strFind & """,Auszahlungen!C[-2],""ausgezahlt"")"
.Cells(q, 9).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(IFERROR(LEFT(RC[-2],SEARCH("" "",RC[-2],1) -1),RC[-2]),Panels!C[-7],1,0)),""nicht aktiv"",""aktiv"")"
.Cells(q, 11).FormulaR1C1 = "=RANK(RC[2],C[2],1)"
.Cells(q, 12).FormulaR1C1 = "=""" & strFind & " (€ ""&TEXT(SUMIFS(Auszahlungen!C[-8],Auszahlungen!C[-11],""" & strFind & """,Auszahlungen!C[-6],""ausgezahlt""),""#.##0,00"") & "")"""
.Cells(q, 23).FormulaR1C1 = "=IF(ISERROR(TEXT(INDEX(Panels!C[-22]:C[-15],MATCH(""" & strFind & """,Panels!C[-21],0),8),""TT.MM.JJJ"")),""Status: nicht aktiv"",""Status: aktiv seit "" & (TEXT(INDEX(Panels!C[-22]:C[-15],MATCH(""" & strFind & """,Panels!C[-21],0),8),""TT.MM.JJJ"")))"
.Cells(q, 24).FormulaArray = "=IF(COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"")=1,""Auszahlung: "" & COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"") & "" am "" & TEXT(MAX(IF(Auszahlungen!C[-23]=""" & strFind & """,Auszahlungen!C[-16])),""TT.MM.JJJJ"") & "" in Höhe von € ""&TEXT(SUMIFS(Auszahlungen!C[-20],Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgez" & _
"ahlt""),""#.##0,00""), ""Auszahlungen: "" & COUNTIFS(Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt"")&"" in Höhe von € ""&TEXT(SUMIFS(Auszahlungen!C[-20],Auszahlungen!C[-23],""" & strFind & """,Auszahlungen!C[-18],""ausgezahlt""),""#.##0,00"")&"""")" & _
""
.Cells(q, 27).FormulaR1C1 = "=COUNTIFS(Auszahlungen!C[-26],""" & strFind & """,Auszahlungen!C[-21],""ausgezahlt"")"
Dim strgS As String
Dim rngF As Range
With ThisWorkbook.Worksheets("Auszahlungen")
strgS = ActiveSheet.Cells(Target.Row, 1).Value 'Wert aus Spalte A der Tabelle Anweisung
End With
With ThisWorkbook.Worksheets("Panels")
Set rngF = .Columns(2).Find(strgS, lookat:=xlPart)
If Not rngF Is Nothing Then
DaDate = .Cells(rngF.Row, 8)
End If
End With
'Formel wird in die erste freie Zelle der Spalte m in Top30 geschrieben
With ThisWorkbook.Worksheets("Top30")
.Cells(.Cells(.Rows.Count, 13).End(xlUp).Row + 1, 13).Formula = "=DATEDIF(DateValue(""" & DateValue(DaDate) & """),TODAY()," & """M""" & ")/(COUNTIFS(Auszahlungen!A:A,""" & strFind & """,Auszahlungen!F:F," & """ausgezahlt""" & "))"
End With
.Cells(q, 14).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(IFERROR(LEFT(RC[-2],SEARCH("" "",RC[-2],1) -1),RC[-2]),Panels!C[-12],1,0)),""nicht aktiv"",""aktiv"")"
With ThisWorkbook.Worksheets("Top30")
Set rngFind5 = ThisWorkbook.Worksheets("Top30").Columns(2).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte B
Set rngFind6 = ThisWorkbook.Worksheets("Top30").Columns(7).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte G
Set rngFind7 = ThisWorkbook.Worksheets("Top30").Columns(12).Find(what:=strFind, lookat:=xlPart) 'suche Wert aus Spalte A in Top30 in Spalte L
If Not rngFind5 Is Nothing Then
RangnachBeträgen = .Cells(rngFind5.Row, 1)
RangnachmeistenAuszahlungen = .Cells(rngFind6.Row, 6)
RangnachderHäufigkeit = .Cells(rngFind7.Row, 11)
End If
End With
.Cells(q, 16).FormulaR1C1 = RangnachBeträgen
.Cells(q, 17).FormulaR1C1 = strFind
.Cells(q, 18).FormulaR1C1 = Date
.Cells(q, 19).FormulaR1C1 = RangnachmeistenAuszahlungen
.Cells(q, 20).FormulaR1C1 = strFind
.Cells(q, 21).FormulaR1C1 = RangnachderHäufigkeit
.Cells(q, 22).FormulaR1C1 = strFind
ThisWorkbook.Worksheets("Top30").Activate
Top30alleanzeigen
Top30anzeigen
ThisWorkbook.Worksheets("Auszahlungen").Activate
With ThisWorkbook.Worksheets("Auszahlungen")
.Cells(Target.Row, 8) = Date
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat = Worksheets("Auszahlungen").Range("L5").Value
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst = Worksheets("Jahresstatistik").Range("E2").Value
Jahresranking = Worksheets("Jahresstatistik").Range("F2").Value
MsgBox "Folgende Rangordnung gibt es bei """ & Target.Offset(0, -6).Value & """:" & String(2, vbNewLine) & _
"nach Beträgen: " & RangnachBeträgen & String(1, vbNewLine) & _
"nach meisten Auszahlungen: " & RangnachmeistenAuszahlungen & String(1, vbNewLine) & _
"nach der Häufigkeit: " & RangnachderHäufigkeit & String(2, vbNewLine) & _
"Es sind noch keine alten Werte bezüglich Vergleiche vorhanden." & String(2, vbNewLine) & _
"-------------------------------------------------------------------------" & String(2, vbNewLine) & _
VergleichaktuellerAuszahlungsmonatmithöchestemAuszahlungsmonat & String(2, vbNewLine) & _
VergleichaktuellerGesamtverdienstmitbestemGesamtVerdienst & String(2, vbNewLine) & _
Jahresranking
End With
End With
End If
End With
With ThisWorkbook.Worksheets("Auszahlungen")
If .Range("K8").Value > .Range("I1").Value Then
MsgBox "Gratuliere, du hast soeben die höchste Auszahlung in Höhe von € " & Format(.Range("K8").Value, "#,##0.00") & " erhalten, welche dir von """ & .Range("L7").Value & """ heute ausbezahlt wurde. Dieser Betrag ist um € " & Format((.Range("K8").Value - .Range("I1").Value), "#,##0.00") & " höher, welcher dir von """ & .Range("L8").Value & """ am " & .Range("I2") & " ausbezahlt wurde."
.Range("I1").Value = .Range("K8").Value
.Range("L8").Value = .Range("L7").Value
.Range("I2").Value = .Range("L6").Value
End If
If .Range("K7").Value > .Range("I3").Value Then
MsgBox "Der durchschnittliche Auszahlungsbetrag hat sich soeben von € " & Format(.Range("I3").Value, "#,##0.00") & " auf " & String(1, vbNewLine) & _
"€ " & Format(.Range("K7"), "#,##0.00") & " erhöht. Das entspricht um € " & Format((.Range("K7").Value - .Range("I3").Value), "#,##0.00") & " mehr seit der letzten Auszahlung."
.Range("I3").Value = .Range("K7").Value
End If
If .Range("K6").Value < .Range("I4").Value Then
MsgBox "Die durchschnittliche Dauer zwischen Beantragung und Auszahlung hat sich von " & .Range("I4").Value & " Tage auf " & .Range("K6").Value & " Tage verringert."
.Range("I4").Value = .Range("K6").Value
End If
If .Range("K5").Value > .Range("I5").Value Then
MsgBox "Die durchschnittliche Anzahl an Auszahlungen pro Monat hat sich von " & .Range("I5").Value & " auf " & .Range("K5").Value & " erhöht."
.Range("I5").Value = .Range("K5").Value
End If
End With
End If
End If
End Sub
Excel Version 2016
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
Moin!
Ich werde den Code nicht analysieren.
Entscheidend ist doch eher, dass Du die Fehlerquelle eingrenzen musst!
Ein kurzer Blick in die VBA-Hilfe zu .FormulaArray [klick] ergibt, dass die Formel maximal 255 Zeichen haben darf, was bei Dir weit überschritten wird.
Obiges hilft Dir jetzt zwar auch nicht weiter, aber:
Kannst Du Zwischenrechnungen in Hilfsspalten auslagern?
Bietet sich nicht eher ein Tabellenobjekt ("intelligente" Tabelle, Strg+t) an?
Dann brauchst Du Dich nicht um die Fortschreibung der Formeln zu kümmern!
Oder Du "ziehst" die Formel mittels VBA.Range.Autofill
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
22.11.2018, 09:32
(Dieser Beitrag wurde zuletzt bearbeitet: 22.11.2018, 09:32 von LCohen.)
Das finde ich jetzt aus folgendem Grunde unfair: In Deinem OP hättest Du mitteilen müssen, dass auch die .FormulaR1C1-Syntax so nicht funktioniert. Täte sie es, ginge auch mein Vorschlag.
Das hast Du nicht getan. Du suggerierst, dass Dir nur noch die {} fehlen, sonst aber die Formel gültig ist.
Ich habe aber nicht geantwortet, weil ich mich inhaltlich mit Deiner Formel auseinandersetzen wollte, was ich nun müsste.
EDIT: Ich ziehe den roten Teil zurück aufgrund der Korrektur durch RPP63. Hilfe: Auslagern in benannte Formelteile. Die aber wiederum machen das Array dann evtl. von vornherein überflüssig.
|
