Formel, die Werte in anderem Tabellenblatt sucht

Alba · 2018-03-06T08:31:32+00:00

Hallo zusammen ich habe ein Problem. Ich brauche eine Formel die folgendes macht: Im Tabellenblatt Werkstoffaufstellung ab Spalte I6 die eingegebenen Werte im Tabellenblatt Bleche suchen. Und die gefundenen Werte im Tabellenblatt Werkstoffaufstellung wie folgend ergänzen: Blech Spalte E = Spalte H Werkstoffaufstellung Blech Spalte D = Spalte G Werkstoffaufstellung Blech Spalte C = Spalte F Werkstoffaufstellung Blech Spalte B = Spalte E Werkstoffaufstellung Blech Spalte A = Spalte D Werkstoffaufstellung Wenn kein passender Wert gefunden wird sollte die UserForm2 Automatisch aufgehen wo man die fehlenden Werte ergänzen kann. Im Anhang eine Beispieldatei. https://www.herber.de/bbs/user/120223.zip Danke im Voraus für jede Hilfe!!!!

Hallo
Ich habe mir den bereits existierenden Code NICHT angesehen...

Dieser muss in den Codebereich von Blatt Werkstoffaufstellung
Er wird ausgeführt, wenn in Spalte I ab Zeile 6 eine Änderung erfolgt

Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error GoTo Fehler 
    If Not Intersect(Range("I:I"), Target) Is Nothing Then 
        If Target.Row < 6 Then Exit Sub 
        If Target.Count > 1 Then 
            MsgBox "Bitte einzeln bearbeiten" 
            With Application 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
            End With 
            Exit Sub 
        End If 
         
        Dim TbB As Worksheet 
        Dim Zeile As Double, FFind As Integer, SP As Integer 
         
        Set TbB = Sheets("Bleche") 
        FFind = 6 ' Finde in Spalte F 
         
        'prüfen ob vorhanden 
        If WorksheetFunction.CountIf(TbB.Columns(FFind), Target.Value) > 0 Then 
            Zeile = WorksheetFunction.Match(Target.Value, TbB.Columns(FFind), 0) 
            For SP = 1 To 5 
                If TbB.Cells(Zeile, SP) = "" Then 
                    UserForm2.TextBox89 = Target.Value 
                    UserForm2.Show 
                Else 
                    Application.EnableEvents = False 
                    Target.Offset(0, -6 + SP) = TbB.Cells(Zeile, SP) 
                    Application.EnableEvents = True 
                End If 
            Next 
        Else 
            Application.EnableEvents = False 
            Target.Offset(0, -5).Resize(1, 5).ClearContents 
            Application.EnableEvents = True 
            UserForm2.TextBox89 = Target.Value 
            UserForm2.Show 
        End If 
         
    End If 
    '*** Fehlerbehandlung 
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub

LG UweD

Hallo nochmal
dann so?

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fehler
    If Not Intersect(Range("I:I"), Target) Is Nothing Then
        If Target.Row < 6 Then Exit Sub
         
        Dim TbB As Worksheet
        Dim Zeile As Double, FFind As Integer, SP As Integer, Z
         
        Set TbB = Sheets("Bleche")
        FFind = 6 ' Finde in Spalte F 
         
        For Each Z In Target
            'prüfen ob vorhanden 
            If WorksheetFunction.CountIf(TbB.Columns(FFind), Z.Value) > 0 Then
                Zeile = WorksheetFunction.Match(Z.Value, TbB.Columns(FFind), 0)
                For SP = 1 To 5
                    If TbB.Cells(Zeile, SP) = "" Then
                        UserForm2.TextBox89 = Z.Value
                        UserForm2.Show
                    Else
                        Application.EnableEvents = False
                        Z.Offset(0, -6 + SP) = TbB.Cells(Zeile, SP)
                        Application.EnableEvents = True
                    End If
                Next
            Else
                Application.EnableEvents = False
                Z.Offset(0, -5).Resize(1, 5).ClearContents
                Application.EnableEvents = True
                UserForm2.TextBox89 = Z.Value
                UserForm2.Show
            End If
        Next
         
    End If
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD

Formel, die Werte in anderem Tabellenblatt sucht

Forumthread: Formel, die Werte in anderem Tabellenblatt sucht

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Formel, die Werte in anderem Tabellenblatt sucht

Forumthread: Formel, die Werte in anderem Tabellenblatt sucht

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread