Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Geschwungene Klammer mittels VBA Code erzeugen
#1
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
Synology DS416play (1 Seagate IronWolf ST8000VN0022) + DVBLogic TVButler DVB-C/T/T2 (100tc) Stick, Synology RT1900AC Router, Samsung UE60F6370 + UE50ES5700 + UE48H6470, Panasonic TX-L32E5E + TX-24CSW504, Windows 10 PC, Samsung Galaxy Tab S2, Samsung Galaxy S8+
Antwortento top
#2
.FormulaArray statt .FormulaR1C1

Alternativ kann man in vielen Fällen ein INDEX einschleusen und darauf verzichten.
Antwortento top
#3
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
Synology DS416play (1 Seagate IronWolf ST8000VN0022) + DVBLogic TVButler DVB-C/T/T2 (100tc) Stick, Synology RT1900AC Router, Samsung UE60F6370 + UE50ES5700 + UE48H6470, Panasonic TX-L32E5E + TX-24CSW504, Windows 10 PC, Samsung Galaxy Tab S2, Samsung Galaxy S8+
Antwortento top
#4
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)
Antwortento top
#5
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.
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste