Thema Datum  Von Nutzer Rating
Antwort
Rot Makro kaputt verbessert
22.02.2024 20:58:06 Alex
NotSolved
22.02.2024 23:15:30 Gast38423
NotSolved

Ansicht des Beitrags:
Von:
Alex
Datum:
22.02.2024 20:58:06
Views:
251
Rating: Antwort:
  Ja
Thema:
Makro kaputt verbessert

Hallo liebes VBA Forum Team,

Ich bin ein absolter Neuling auf dem Gebiet VBA und habe mein wissen nur von Youtube Videos bitte seid nett zu mir =)

Ich habe ein Makro gebaut:


Option Explicit

Const ws_DB As String = "Bestand"
Const ws_Eingabe As String = "Ersatzteil_Anlegen"

Sub Ersatzteil_Anlegen_EingabeDB()

    Dim tbl As ListObject
    Dim header As Variant
    Dim Spalte As Long
    Spalte = 1

    With Worksheets(ws_DB)
        
        'Tabelle einlesen
        Set tbl = .ListObjects(1)
        
        'Zeile einfügen
        tbl.ListRows.Add
        
        'Zeilenhöhe einfügen
        .Rows(tbl.DataBodyRange.Rows.Count + tbl.HeaderRowRange.Row).RowHeight = .Rows(tbl.HeaderRowRange.Row + 1).RowHeight

    End With

    With Worksheets(ws_Eingabe)

        'Schleife über allen Tabellenheader
        For Each header In tbl.HeaderRowRange
        
            If header <> "Differenz" Then ' Wenn der Header nicht "Differenz" ist, fahre fort
                tbl.DataBodyRange(tbl.DataBodyRange.Rows.Count, Spalte).Value = _
                 .Range(.Cells.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 2).Address).Value
                Spalte = Spalte + 1
            End If

        Next header

    End With

End Sub

Dieses Funktioiert wunderbar, nun wollte ich das Makro um die Funktion erweitern, das es vor der Eingabe in die Tabelle prüft ob der einzugebende Wert in der Spalte Artikelnummer schon vorhanden ist  und falls dies der Fall ist eine Fehlermeldung auswirft.

Option Explicit

Const ws_Bestand As String = "Bestand"
Const ws_Eingabe As String = "Ersatzteil_Anlegen"
Const ArtikelnummerZelle As String = "Q17"

Sub Ersatzteil_Anlegen_EingabeDB()

    Dim tbl As ListObject
    Dim header As Variant
    Dim Spalte As Long
    Dim Artikelnummer As Variant
    Dim ZielZelle As Range
    
    Spalte = 1

    With Worksheets(ws_Eingabe)
        
        'Die Artikelnummer aus dem Eingabeblatt lesen
        Artikelnummer = .Range(ArtikelnummerZelle).Value
        
    End With

    With Worksheets(ws_Bestand)
        
        'Die Tabelle "Bestand" einlesen
        Set tbl = .ListObjects(1)
        
        'Die Zelle mit der Überschrift "Artikelnummer" in der Tabelle "Bestand" finden
        Set ZielZelle = .Range("E11")
        
        'Überprüfen, ob die Artikelnummer bereits vorhanden ist
        If Not ZielZelle Is Nothing Then
            Dim letzteZeile As Long
            letzteZeile = .Cells(.Rows.Count, ZielZelle.Column).End(xlUp).Row
            If Not IsError(Application.Match(Artikelnummer, .Range(.Cells(ZielZelle.Row + 1, ZielZelle.Column), .Cells(letzteZeile, ZielZelle.Column)), 0)) Then
                MsgBox "Die eingegebene Artikelnummer ist bereits vorhanden!", vbExclamation
                Exit Sub
            End If
        Else
            MsgBox "Die Überschrift 'Artikelnummer' wurde nicht gefunden!", vbExclamation
            Exit Sub
        End If
    End With
      
    With Worksheets(ws_Eingabe)
        'Schleife über allen Tabellenheader
        For Each header In tbl.HeaderRowRange
            If header <> "Differenz" Then
            
            ' Wenn der Header nicht "Differenz" ist, fahre fort
                tbl.DataBodyRange(tbl.DataBodyRange.Rows.Count, Spalte).Value = _
                 .Range(.Cells.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 2).Address).Value
                Spalte = Spalte + 1
            
            End If
        Next header
    End With

End Sub

Dies Funktioniert auch, aber jetzt ist es so das wenn die Artikelnummer nicht vorhahnden ist keine weitere Soalte in der Tabelle hinzufügt sondern es wird einfach immer die erste Spalte ersetzt.

Ich hoffe ihr könnt mir helfen,

Gruß Alex


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro kaputt verbessert
22.02.2024 20:58:06 Alex
NotSolved
22.02.2024 23:15:30 Gast38423
NotSolved