Texbox Suche mit Übergabe Formelerweiterung

[LexLea]

Hallo zusammem

Hätte eine kleine Fragen
Habe eine Texbox(4 Kostenstelle) Suche mit Übergabe und möchte nun diese erweiterten
Hier mal mein Code

Private Sub Update_Click()
Dim rngFind As Range

Set rngFind = Sheets("Eingabe").Columns("D:D").Find(What:=TextBox4.Text, _
            LookAt:=xlWhole, LookIn:=xlValues)
            
    rngFind.Offset(0, 0 - 3).Value = TextBox1.Text
    rngFind.Offset(0, 1 - 3).Value = TextBox2.Text
    rngFind.Offset(0, 2 - 3).Value = TextBox3.Text
    rngFind.Value = TextBox4.Text
    rngFind.Offset(0, 4 - 3).Value = TextBox5.Text
    rngFind.Offset(0, 5 - 3).Value = TextBox6.Text
    rngFind.Offset(0, 6 - 3).Value = TextBox7.Text
    rngFind.Offset(0, 7 - 3).Value = TextBox8.Text
    rngFind.Offset(0, 8 - 3).Value = TextBox9.Text
    rngFind.Offset(0, 9 - 3).Value = TextBox10.Text
    rngFind.Offset(0, 10 - 3).Value = TextBox11.Text
    rngFind.Offset(0, 11 - 3).Value = TextBox12.Text
    rngFind.Offset(0, 12 - 3).Value = TextBox14.Text
    rngFind.Offset(0, 15 - 3).Value = TextBox16.Text
    rngFind.Offset(0, 16 - 3).Value = TextBox17.Text
    rngFind.Offset(0, 17 - 3).Value = TextBox18.Text
    rngFind.Offset(0, 18 - 3).Value = TextBox19.Text
    rngFind.Offset(0, 19 - 3).Value = TextBox20.Text
    rngFind.Offset(0, 20 - 3).Value = TextBox21.Text
    rngFind.Offset(0, 21 - 3).Value = TextBox22.Text
    rngFind.Offset(0, 22 - 3).Value = TextBox23.Text
    rngFind.Offset(0, 23 - 3).Value = TextBox24.Text
    rngFind.Offset(0, 24 - 3).Value = TextBox25.Text
    rngFind.Offset(0, 25 - 3).Value = TextBox26.Text
    rngFind.Offset(0, 26 - 3).Value = TextBox27.Text
    rngFind.Offset(0, 27 - 3).Value = TextBox28.Text
    rngFind.Offset(0, 28 - 3).Value = TextBox29.Text
    rngFind.Offset(0, 29 - 3).Value = TextBox30.Text
    rngFind.Offset(0, 30 - 3).Value = TextBox31.Text
    rngFind.Offset(0, 31 - 3).Value = TextBox32.Text
    rngFind.Offset(0, 32 - 3).Value = TextBox33.Text
    rngFind.Offset(0, 33 - 3).Value = TextBox34.Text
    rngFind.Offset(0, 34 - 3).Value = TextBox35.Text

    TextBox4.SetFocus
    MsgBox "Daten wurden aktualisiert"
End Sub


Nun würde ich gerne die Suche der Textbox 4 erweitern auf den Bereich AM1 bis BM1
und wenn die Kostenstelle gefunden wurde soll es die Textbox20+21+22 in die Zelle schreiben
und bei veränderungen eine Zelle darunter so das eine Aufzeichnung ensteht was gemacht wurde

Danke euch mal im vorhinein

[Phi.VBA]

@LexLea

es gibt Situationen, in denen so viele Textboxen ein guter Ansatz sind. Lade bitte ein kleine, aber aussagefähige Datei hoch. Dann kommen (vielleicht) Vorschläge.

[LexLea]

@ Phi.VBA


Danke
Habe deinen Ratschlag berücksichtig und meine Datei im Anhang

Die Speicherung soll über den Update Button erfolgen


  Test1.xlsm (Größe: 124,44 KB / Downloads: 7)

[Phi.VBA]

aus Sicherheitsgründen öffne ich fremde Dateien nur ohne Makros:

- in den Blättern ist das Ziel schwer zu erkennen
- Workbook_Open event
- Klassenmodul mit API's

Der Code ist in einer beschränkten Zeit schwer auf Risiken zu prüfen

[LexLea]

@ Phi.VBA

Habe alles was für das Problem nicht von relevanz ist aus der Datei genommen
Hoffe es Hilft dabei das Problem zu lösen


  Test2.xlsm (Größe: 51,73 KB / Downloads: 3)

[Phi.VBA]

@LexLea

im Prinzip so:

Code:

set rng = sheets("Eingabe").Range("AM1:BM1").find(TextBox4.Text,,xlvalues, xlwhole)
if not rng is nothing then
    'hier dein Code
end if

ungeprüft

[LexLea]

@Phi.VBA

Alleinestehend ohne die erste Suche funktioniert es den Bereich zu Finden
aber beide zusammen bekomme ich den Fehler (Fehler beim Kompilieren)

Private Sub Update_Click()
Dim rngFind As Range

Set rngFind = Sheets("Eingabe").Columns("D:D").Find(What:=TextBox4.Text, _
            LookAt:=xlWhole, LookIn:=xlValues)
            
    rngFind.Offset(0, 0 - 3).Value = TextBox1.Text
    rngFind.Offset(0, 1 - 3).Value = TextBox2.Text
    rngFind.Offset(0, 2 - 3).Value = TextBox3.Text
    rngFind.Value = TextBox4.Text
    ...........................
    rngFind.Offset(0, 34 - 3).Value = TextBox35.Text

Set rngFind = Sheets("Eingabe").Range("AM1:BM1").Find(TextBox4.Text, , xlValues, xlWhole)
If Not rngFind Is Nothing Then
    Range("A65536").End(xlUp).Offset(1, 0).Select
    
   rngFind.Offset(1, 0).Value = TextBox35.Text
    
    TextBox4.SetFocus
    MsgBox "Daten wurden aktualisiert"
End Sub

[LexLea]

Hallo

Habe nun einzelne Buttons erstellt
Die Suche geht super aber mit dem Speichern letzte Zeile funktioniert leider nicht wirklich überschreibt immer die gleiche Zeile


Private Sub Wechsel_Click()
Dim rngFind As Range

Set rngFind = Sheets("Eingabe").Range("AM1:BM1").Find(TextBox4.Text, , xlValues, xlWhole)
    If Not rngFind Is Nothing Then
     
    rngFind.Value = TextBox4.Text
    rngFind.End(xlUp).Offset(1, 0).Value = TextBox20.Text & Chr(10) & TextBox21.Text & Chr(10) & TextBox22.Text & Chr(10)
    rngFind.Value = Application.Substitute([rngFind], Chr(10), "")
    
    TextBox4.SetFocus
End If
    MsgBox "Daten wurden aktualisiert"
End Sub


Hätte jemand eine Idee

[schauan]

Hallöchen,

ist diese Vorgehensweise korrekt?

rngFind.End(xlUp).Offset(1, 0).Value

Von der gefundenen Zelle gehst Du nach oben und dann von oben eine Zelle runter. Wenn sich "oben" nix ändert kommst Du dann immer in die zweite Zelle von oben.

[LexLea]

Ohhh Looo

Gott straft die Blinden

Hätte mir das noch 1000 mal angeschaut und wäre immer wieder drübergeflogen über den fehler

Danke