|
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
|