Visual Basic Wert in Tabelle eintragen und erweitern

Hallo liebe Leute,

ich bekam damals schon einen sehr guten Tipp für meine kleine Excel Tabelle. Virtual Basic Wert in eine Zelle eintragen

Nun würde ich mir gerne noch eine kleine Erleichterung einbauen.

Ich arbeite ziemlich oft mit dieser Liste und habe ein SVerweis der die Produkte und dessen Daten abruft.

Da immer wieder neue Produkte hinzukommen, würde ich gerne wie im Bild dargestellt mit einer kleinen VB Hilfe mir die Arbeit erleichtern.

Die Schwierigkeit sehe ich für mich, dass das Skript in der 'range' A1:A15 auf die nächste leere Zeilen prüfen muss, um dort den neuen Wert eintragen zu können.

Vielleicht habt ihr eine Idee

liebe Grüße und vielen Dank im Voraus

Termiman

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 253322

Url: https://administrator.de/contentid/253322

Ausgedruckt am: 26.11.2024 um 07:11 Uhr

4 Kommentare

Neuester Kommentar

ganz einfach, mit :

Range("A1").End(xlDown).Offset(1,0)

oder

Cells(Rows.Count,1).End(xlUp).Offset(1,0)

erhältst du immer die nächste leere Zelle in Spalte A

Gruß jodel32

p.s. und Pack das "Virtuelle" Basic weg, das heißt "Visual" Basic

Hey Jodel32. Erst einmal vielen Dank für die kleine Verbesserung. face-smile

Habe schon versucht das ganze umzusetzen. Wollte das von meiner anderen Formel anpassen, bisslang noch ohne Erfolg

Sub ChangePrice()
Dim rgFound As Excel.Range
Set rgFound = ActiveSheet.Range("A1").End(xlDown).Row).Find(ActiveSheet.Range("E3"), , , xlWhole, , , True)
Else
rgFound.Offset(0, 1, 2) = ActiveSheet.Range("F3")
End If
End Sub

!!!!!!!

Wenn du mir noch einen kleine Hilfestellung geben kannst, sonst probiere ich erst einmal weiter.

liebe Grüsse

Termiman

Hallo Termiman,
machst du so:

Sub ChangePrice()
    Dim rgFound As Range,rgNew As Range
    With ActiveSheet
        'Produktnummer suchen im Bereich A2:A?  
        Set rgFound = .Range("A2:A" & .Range("A1").End(xlDown).Row).Find(.Range("E4"), LookIn:=xlValues, Lookat:=xlWhole)  

        If rgFound Is Nothing Then
            'Wurde kein Produkt gefunden ermittle die nächste leere Zelle und  übertrage die Werte des neuen Produktes dorthin  
            Set rgNew = .Range("A1").End(xlDown).Offset(1, 0)  
            .Range(rgNew, rgNew.Offset(0, 2)).Value = .Range("E4:G4").Value  
        Else
             'Produkt wurde gefunden, ändere dessen Werte entsprechend  
            .Range(rgFound, rgFound.Offset(0, 2)).Value = .Range("E4:G4").Value  
        End If
    End With
End Sub

Grüße Uwe

Hey Uwe,

WOW, vielen Dank funktioniert prima, vor Allem das gleich geprüft wird ob das Produkt schon existent ist. Klasse!!!

Nochmals, danke an euch beiden für die schnelle Hilfe