Werte werden in falsche Zeile geschrieben

[dertommy]

Hallo!

Folgende Ausgangssituation:
Im Tabellenblatt "Anweisungen" gebe ich in Spalte "F" ein "j" ein. Dies hat zur Folge, dass bestimmte Werte ins Tabellenblatt "Top30" geschrieben werden. Ist vom Tabellenblatt "Anweisungen" der Wert aus Spalte "A" im Tabellenblatt "Top30" in Spalte "B" noch nicht vorhanden, wird dieser im Tabellenblatt "Top30" angelegt. Soweit so gut, das funktioniert auch alles.

Nun zu meinem Problem, wenn der Wert bereits vorhanden ist. Hier möchte ich, dass der Wert aus Spalte "A" vom Tabellenblatt "Anweisungen" genommen wird und im Tabellenblatt "Top30" in der Spalte "Q" gesucht wird und dann gleich links daneben in Spalte "P" der Wert aus der Spalte "A" (auch Tabellenblatt "Top30") in Bezug auf den gesuchten Wert in Spalte "Q" genommen wird.

Mein Problem ist nun, dass er zwar den richtigen Wert ermittelt, mir aber in die falsche Zeile schreibt, nämlich nicht direkt nach dem gesuchten Wert aus Spalte "A" aus Tabellenblatt "Anweisungen", sondern einfach zum Schluss vom Tabellenblatt, was ich nicht möchte.

Ich habe die Datei mit angehängt, damit man sich das ganze besser vorstellen kann.
Ich hoffe, dass jemand Zeit hat, mir zu helfen.

Anbei auch der Code vom Tabellenblatt "Anweisungen":

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("Anweisungen").Activate
                   x = Range("A65536").End(xlUp).Row
                   Cells(x + 0, 6).Select
                   Exit Sub
                   
           End If
End If
               
If Target.Column = 6 Then 'in Spalte E
       
       If ActiveSheet.Cells(Target.Row, 1).Value <> vbNullString Then 'und Spalte A nicht leer ist
             
           With ThisWorkbook.Worksheets("Anweisungen")
               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 L
               If Not rngFind Is Nothing Then 'Wenn Wert existiert dann
                   RangnachBeträgeneu = .Cells(rngFind.Row, 1)
                   RangnachmeistenAuszahlungenaltneu = .Cells(rngFind2.Row, 6)
                   RangnachderHäufigkeitneu = .Cells(rngFind3.Row, 11)
                   RangnachBeträgealt = .Cells(rngFind4.Row, 16)
                   ThisWorkbook.Worksheets("Top30").Activate
                   Top30alleanzeigen
                   Top30anzeigen
                   ThisWorkbook.Worksheets("Anweisungen").Activate
                   
                   With ThisWorkbook.Worksheets("Anweisungen")
                 
                   .Cells(Target.Row, 7) = Date
                           MsgBox "Folgende Rangordnung gibt es bei """ & Target.Offset(0, -5).Value & """:" & String(2, vbNewLine) & _
                           "nach Beträgen: " & RangnachBeträgeneu & String(1, vbNewLine) & _
                           "nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenaltneu & String(1, vbNewLine) & _
                           "nach der Häufigkeit: " & RangnachderHäufigkeitneu & String(1, vbNewLine) & _
                           "alter Wert: " & RangnachBeträgealt
                           
                   End With
                   
                   With ThisWorkbook.Worksheets("Top30")
                       q = .Cells(6, 1).CurrentRegion.Rows.Count
                       .Cells(q, 16).FormulaR1C1 = RangnachBeträgeneu
                   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(Anweisungen!C[-1],""" & strFind & """,Anweisungen!C[3],""ausgezahlt"")& ""x)"""
                       .Cells(q, 3).FormulaR1C1 = "=SUMIFS(Anweisungen!C[1],Anweisungen!C[-2],""" & strFind & """,Anweisungen!C[2],""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(Anweisungen!C[-3],Anweisungen!C[-6],""" & strFind & """,Anweisungen!C[-2],""ausgezahlt""),""#.##0,00"") & "")"""
                       .Cells(q, 8).FormulaR1C1 = "=COUNTIFS(Anweisungen!C[-7],""" & strFind & """,Anweisungen!C[-3],""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(Anweisungen!C[-8],Anweisungen!C[-11],""" & strFind & """,Anweisungen!C[-7],""ausgezahlt""),""#.##0,00"") & "")"""
                                           
                       Dim strgS As String
                       Dim rngF As Range

                       With ThisWorkbook.Worksheets("Anweisungen")
                           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, 7)
                           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(Anweisungen!A:A,""" & strFind & """,Anweisungen!E:E," & """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ägealt = .Cells(rngFind5.Row, 1)
                               RangnachmeistenAuszahlungenalt = .Cells(rngFind6.Row, 6)
                               RangnachderHäufigkeitalt = .Cells(rngFind7.Row, 11)
                           End If
                       End With
                       
                       .Cells(q, 16).FormulaR1C1 = RangnachBeträgealt
                       .Cells(q, 17).FormulaR1C1 = strFind
                   
                       ThisWorkbook.Worksheets("Top30").Activate
                       Top30alleanzeigen
                       Top30anzeigen
                       ThisWorkbook.Worksheets("Anweisungen").Activate
                       
                       With ThisWorkbook.Worksheets("Anweisungen")
                           .Cells(Target.Row, 7) = Date
                           MsgBox "Folgende Rangordnung gibt es bei """ & Target.Offset(0, -5).Value & """:" & String(2, vbNewLine) & _
                           "nach Beträgen: " & RangnachBeträgealt & String(1, vbNewLine) & _
                           "nach meisten Auszahlungen: " & RangnachmeistenAuszahlungenalt & String(1, vbNewLine) & _
                           "nach der Häufigkeit: " & RangnachderHäufigkeitalt & String(1, vbNewLine) & _
                           "alter Wert: noch keiner vorhanden"
                       End With
                       
                   End With
                                                     
               End If
               
            End With
           
       End If
   
End If

End Sub

LG
Thomas

[dertommy]

Hallo!

Eigentlich geht es bei dem langen Code genau um diese Passage, wo definiert werden soll, wo der Wert eingetragen werden soll. Vielleicht hilft das für eine Antwort und ihr müsst nicht den Rest des Codes anschauen.

Code:

With ThisWorkbook.Worksheets("Top30")
                       q = .Cells(6, 1).CurrentRegion.Rows.Count
                       .Cells(q, 16).FormulaR1C1 = RangnachBeträgeneu
End With

Danke und
LG
Thomas

[RPP63]

Moin Thomas!
Ich habe mir die Datei nicht angesehen, beziehe mich aber auf meine Hilfe im anderen Thread.

.Cells(6, 1).CurrentRegion
bezieht sich auf den benutzen Bereich um A6 herum!
Gehe mal manuell in Zelle A6 und drücke Strg+a
Ich nehme an, dass auch Zeilen über A6 markiert werden.

Mal ein paar Beispiele, wie man die letzte Zeile/Spalte ermittelt:
http://www.rondebruin.nl/win/s9/win005.htm
(Deine Variante ist nicht darunter ;))

Gruß Ralf

[RPP63]

So, ich habe es mir jetzt mal angetan.  :22:
Sorry, aber ist der reinste Horror!
Wenn Du die Tabellen in ListObjects (intelligente Tabellen, Einfügen, Tabelle oder Strg+t) umwandeln würdest, könntest Du Dir den ganzen Makro-Plumpaquatsch sparen.

Ich gehe davon aus, dass dieses Werk nicht von Dir stammt (siehe Deine Verständnisfragen).
Und nein:
Ich habe nicht die Zeit und auch keine Lust, das komplett zu überarbeiten.
… wenn ich alleine 43(!) Module sehe; wer soll sich da durcharbeiten? …

Nix für ungut und Gruß
Ralf

[Steffl]

Hallo Thomas,

wenn ich mir deinen Satz

Mein Problem ist nun, dass er zwar den richtigen Wert ermittelt, mir aber in die falsche Zeile schreibt, nämlich nicht direkt nach dem gesuchten Wert aus Spalte "A" aus Tabellenblatt "Anweisungen", sondern einfach zum Schluss vom Tabellenblatt, was ich nicht möchte.

betrachte, müsste es so gehen

Code:

With ThisWorkbook.Worksheets("Top30")
'                        q = .Cells(6, 1).CurrentRegion.Rows.Count
                       .Cells(rngFind.Row + 1, 16).FormulaR1C1 = RangnachBeträgeneu
End With

Ansonsten, finde ich das du mit deinen Code schon etwas Probleme bekommen könntest. Zum Beispiel hier

Code:

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 L
                If Not rngFind Is Nothing Then 'Wenn Wert existiert dann
                    RangnachBeträgeneu = .Cells(rngFind.Row, 1)
                    RangnachmeistenAuszahlungenaltneu = .Cells(rngFind2.Row, 6)
                    RangnachderHäufigkeitneu = .Cells(rngFind3.Row, 11)
                    RangnachBeträgealt = .Cells(rngFind4.Row, 16)

rngFind2 und folgende könnten auch Nothing sein und dann läuft der Code in einen Fehler.

[dertommy]

Hallo Steffl!

Danke für den Code:

Code:

With ThisWorkbook.Worksheets("Top30")
'                        q = .Cells(6, 1).CurrentRegion.Rows.Count
                       .Cells(rngFind.Row + 1, 16).FormulaR1C1 = RangnachBeträgeneu
End With

Jetzt funktioniert es genau so, wie ich es wollte.
Über den Rest mache ich mir noch Gedanken.
LG