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.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Werte werden in falsche Zeile geschrieben

Thema geschlossen 
Baumstrukturmodus
Werte werden in falsche Zeile geschrieben
dertommy Offline
Benutzer
Registriert seit: 08.02.2017
Version(en): 2016
#1
18.07.2017, 08:12
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


Angehängte Dateien
.xls   PuU - Kopie.xls (Größe: 853,5 KB / Downloads: 2)
Excel Version 2016
Suchen
Antworten Top
dertommy Offline
Benutzer
ThreadStarter

Registriert seit: 08.02.2017
Version(en): 2016
#2
19.07.2017, 06:13
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
Excel Version 2016
Suchen
Antworten Top
RPP63 Offline
Mitten im Ruhrpott
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
#3
19.07.2017, 07:04
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
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)
Suchen
Antworten Top
RPP63 Offline
Mitten im Ruhrpott
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
#4
19.07.2017, 07:13
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
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)
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#5
19.07.2017, 07:13
Hallo Thomas,

wenn ich mir deinen Satz

dertommy schrieb: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.
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
dertommy Offline
Benutzer
ThreadStarter

Registriert seit: 08.02.2017
Version(en): 2016
#6
19.07.2017, 08:08
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
Excel Version 2016
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


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