VBA: Suchen in Datenbank

[MaMü11]

Hallo zusammen,

ich habe eine Excelmappe mit zwei Blättern. Blatt 1 ist das Steuerungsblatt auf dem ich in ein Feld eine Materialnummer eingeben soll. Durch Klicken auf einen Button soll diese Materialnummer aus der Datenbank, die sich in Blatt 2 befindet, herausgesucht werden. Die Datenbank (Blatt 2) beinhaltet die zwei Spalten Materialnummer und Lieferzeit in Tagen. Auf meinem Steuerungsblatt soll dann in einem Feld unter dem Suchfeld die Materialnummer und dahinter das Lieferdatum ausgegeben werden. Das Lieferdatum berechnet sich dadurch, dass ich auf das heutige Datum die Lieferzeit addiere (Wäre es möglich Wochenenden und Feiertage direkt zu überspringen?).

Das Blatt 1 soll dann z.B wie folgt aussehen:

Bitte Materialnummer eingeben: MAT3884
Das Lieferdatum für die MAT3884 ist: 16.11.2020

Ich hoffe, dass es einigermaßen verständlich ist und ich bin jetzt schon für jede Hilfe dankbar. :18:

Lg

[schauan]

Hallöchen,

könnte Dir nicht auch der SVERWEIS reichen?

[MaMü11]

Hi, ich denke nicht, da ich die Funktionen wahrscheinlich noch erweitern muss und dann hätte ich alles am Liebsten in VBA

[RPP63]

Moin!
Zeig mal die Datei!
Zu heute + Lieferzeit schaue Dir Arbeitstag() an.

Mir persönlich sind etwas viel "ich soll" in Deinem Beitrag. 

Gruß Ralf

[volti]

Hallo MaMü,

hier mal ein Ansatz, wie man das machen könnte.

Parameter ggf. noch anpassen....

Code:

Sub HoleLieferzeit()
 Dim Lieferdatum As Date
 Dim iGefunden As Long
 Dim WSh As Worksheet
 
 Set WSh = ThisWorkbook.Worksheets("Tabelle2")
 
 With ThisWorkbook.Worksheets("Tabelle1").Range("A1")
   On Error Resume Next
   iGefunden = 0
   iGefunden = Application.WorksheetFunction.Match(.value, WSh.Range("A:A"), 0)
   If iGefunden > 0 Then
      Lieferdatum = Date + WSh.Cells(iGefunden, "B").value
      If Weekday(Lieferdatum, vbMonday) > 5 Then Lieferdatum = Lieferdatum + 1
      If Weekday(Lieferdatum, vbMonday) > 5 Then Lieferdatum = Lieferdatum + 1
      If Feiertag(Lieferdatum) <> "" Then Lieferdatum = Lieferdatum + 1
      If Feiertag(Lieferdatum) <> "" Then Lieferdatum = Lieferdatum + 1
      .Offset(1, 0).value = "Die " & .value & " wird geliefert am " & Lieferdatum
  Else
      MsgBox "Diese Materialnummer wurde nicht gefunden!", vbCritical, "Lieferzeit holen"
  End If
 End With
End Sub

Function Feiertag(Datum As Date) As String
    Dim j%, d%
    Dim o As Date
    j = Year(Datum)
    'Osterberechnung
    d = (((255 - 11 * (j Mod 19)) - 21) Mod 30) + 21
    o = DateSerial(j, 3, 1) + d + (d > 48) + 6 - _
        ((j + j \ 4 + d + (d > 48) + 1) Mod 7)
    'Feiertage berechnen
    Select Case Datum
        Case DateSerial(j, 1, 1)
            Feiertag = "Neujahr"
        Case DateSerial(j, 1, 6)
            Feiertag = "Dreikönig*"
        Case DateAdd("D", -2, o)
            Feiertag = "Karfreitag"
        Case o
            Feiertag = "Ostersonntag"
        Case DateAdd("D", 1, o)
            Feiertag = "Ostermontag"
        Case DateSerial(j, 5, 1)
            Feiertag = "Erster Mai"
        Case DateAdd("D", 39, o)
            Feiertag = "Christi Himmelfahrt"
        Case DateAdd("D", 49, o)
            Feiertag = "Pfingstsonntag"
        Case DateAdd("D", 50, o)
            Feiertag = "Pfingstmontag"
        Case DateAdd("D", 60, o)
            Feiertag = "Fronleichnam*"
        Case DateSerial(j, 8, 15)
            Feiertag = "Maria Himmelfahrt*"
        Case DateSerial(j, 10, 3)
            Feiertag = "Deutsche Einheit"
        Case DateSerial(j, 11, 22) - (DateSerial(j, 11, 18) Mod 7)
            Feiertag = "Buß- und Bettag*"
        Case DateSerial(j, 10, 31)
           Feiertag = "Reformationstag*"
        Case DateSerial(j, 11, 1)
            Feiertag = "Allerheiligen*"
        Case DateSerial(j, 12, 24)
            Feiertag = "Heilig Abend*"
        Case DateSerial(j, 12, 25)
            Feiertag = "EWeihnacht"
        Case DateSerial(j, 12, 26)
            Feiertag = "ZWeihnacht"
        Case DateSerial(j, 12, 31)
            Feiertag = "Silvester*"
        Case Else
            Feiertag = ""
    End Select
End Function

______________________
viele Grüße aus Freigericht
Karl-Heinz

[MaMü11]

Vielen Dank für die schnelle Antwort, ich werde mir das direkt mal anschauen.

Wie stelle ich denn sicher, dass meine Materialnummer, die ich im Feld z.B. A1 suchen möchte auch wirklich das Format MAT plus 4 Ziffern hat?

[volti]

Hallo MaMü,

Du kannst vorher einen Check bzgl. der zu suchenden Materialnummer machen, s. Code:

Code:

Option Explicit
Option Compare Text

Sub HoleLieferzeit()
 Dim Lieferdatum As Date
 Dim iGefunden As Long
 Dim WSh As Worksheet
 
 Set WSh = ThisWorkbook.Worksheets("Tabelle2")
 
 With ThisWorkbook.Worksheets("Tabelle1").Range("A1")
   If Not .Value Like "MAT####" Then
     MsgBox "Die Materialnummer '" & .Value & "' ist falsch!" & vbLf & vbLf _
            & "Bitte eine vollständige Materialnummer eingeben!", _
              vbExclamation, "Falsche Materialnummer"
     Exit Sub
   End If
   On Error Resume Next
   iGefunden = 0
   iGefunden = Application.WorksheetFunction.Match(.Value, WSh.Range("A:A"), 0)
   If iGefunden > 0 Then
      Lieferdatum = Date + WSh.Cells(iGefunden, "B").Value
      If Weekday(Lieferdatum, vbMonday) > 5 Then Lieferdatum = Lieferdatum + 1
      If Weekday(Lieferdatum, vbMonday) > 5 Then Lieferdatum = Lieferdatum + 1
      If Feiertag(Lieferdatum) <> "" Then Lieferdatum = Lieferdatum + 1
      If Feiertag(Lieferdatum) <> "" Then Lieferdatum = Lieferdatum + 1
      .Offset(1, 0).Value = "Die " & .Value & " wird geliefert am " & Lieferdatum
  Else
      MsgBox "Diese Materialnummer wurde nicht gefunden!", vbCritical, "Lieferzeit holen"
  End If
 End With
End Sub

Function Feiertag(Datum As Date) As String
    Dim j%, d%
    Dim o As Date
    j = Year(Datum)
    'Osterberechnung
    d = (((255 - 11 * (j Mod 19)) - 21) Mod 30) + 21
    o = DateSerial(j, 3, 1) + d + (d > 48) + 6 - _
        ((j + j \ 4 + d + (d > 48) + 1) Mod 7)
    'Feiertage berechnen
    Select Case Datum
        Case DateSerial(j, 1, 1)
            Feiertag = "Neujahr"
        Case DateSerial(j, 1, 6)
            Feiertag = "Dreikönig*"
        Case DateAdd("D", -2, o)
            Feiertag = "Karfreitag"
        Case o
            Feiertag = "Ostersonntag"
        Case DateAdd("D", 1, o)
            Feiertag = "Ostermontag"
        Case DateSerial(j, 5, 1)
            Feiertag = "Erster Mai"
        Case DateAdd("D", 39, o)
            Feiertag = "Christi Himmelfahrt"
        Case DateAdd("D", 49, o)
            Feiertag = "Pfingstsonntag"
        Case DateAdd("D", 50, o)
            Feiertag = "Pfingstmontag"
        Case DateAdd("D", 60, o)
            Feiertag = "Fronleichnam*"
        Case DateSerial(j, 8, 15)
            Feiertag = "Maria Himmelfahrt*"
        Case DateSerial(j, 10, 3)
            Feiertag = "Deutsche Einheit"
        Case DateSerial(j, 11, 22) - (DateSerial(j, 11, 18) Mod 7)
            Feiertag = "Buß- und Bettag*"
        Case DateSerial(j, 10, 31)
           Feiertag = "Reformationstag*"
        Case DateSerial(j, 11, 1)
            Feiertag = "Allerheiligen*"
        Case DateSerial(j, 12, 24)
            Feiertag = "Heilig Abend*"
        Case DateSerial(j, 12, 25)
            Feiertag = "EWeihnacht"
        Case DateSerial(j, 12, 26)
            Feiertag = "ZWeihnacht"
        Case DateSerial(j, 12, 31)
            Feiertag = "Silvester*"
        Case Else
            Feiertag = ""
    End Select
End Function

______________________
viele Grüße aus Freigericht
Karl-Heinz

[RPP63]

Nixxx für ungut, Karl-Heinz!
Aber WorksheetFunction.Workday() gibt es doch bereits seit Äonen (zumindest als AddIn, seit mindestens 13 Jahren ist es "build-in").

Und die Feiertage würde ich immer als benannten Range in einer (ausgeblendeten) Tabelle fixieren.

Otherwise hätte ich auch noch eine alternative Osterformel (tatsächlich von mir umgesetzt, umgeht so manche "Vereinfachung", wie von Dir dargestellt):

Function Ostersonntag(ByVal j As Integer) As Date

' Ergänzte Gauß-Formel nach Heiner Lichtenberg (1997) 

' http://de.wikipedia.org/wiki/Gau%C3%9Fsc...sterformel 

' VBA-Umsetzung durch RalfP 



' Variablenbedeutung 

' x(0) = Säkularzahl 

' x(1) = säkulare Mondschaltung 

' x(2) = säkulare Sonnenschaltung 

' x(3) = Mondparameter 

' x(4) = Keim für ersten Frühlingsvollmond 

' x(5) = kalendarische Korrekturgröße 

' x(6) = Ostergrenze 

' x(7) = erster Sonntag im März 

' x(8) = Osterentfernung in Tagen 

' x(9) = Datum des Ostersonntags als Märzdatum (32. März = 1. April usw.) 



Dim x(9) As Long

  x(0) = j \ 100

  x(1) = 15 + (3 * x(0) + 3) \ 4 - (8 * x(0) + 13) \ 25

  x(2) = 2 - (3 * x(0) + 3) \ 4

  x(3) = j Mod 19

  x(4) = (19 * x(3) + x(1)) Mod 30

  x(5) = (x(4) + x(3) \ 11) \ 29

  x(6) = 21 + x(4) - x(5)

  x(7) = 7 - (j + j \ 4 + x(2)) Mod 7

  x(8) = 7 - (x(6) - x(7)) Mod 7

  x(9) = x(6) + x(8)

Ostersonntag = DateSerial(j, 3, x(9))

'denn der 32.3. ist automatisch der 1.4. 

End Function

Gruß Ralf

[volti]

Danke Ralf,

für den Hinweis. War mir nicht bekannt, hatte ich nie gebraucht...

Hier dann mal eine verkürzte Version. Die gewünschte Feiertage müssen dann in den benamten Bereich "Feiertage" eingetragen werden.

Code:

Option Explicit
Option Compare Text

Sub HoleLieferzeit()
 Dim Lieferdatum As Date
 Dim iGefunden As Long
 Dim WSh As Worksheet, oFT As Range
 
 Set WSh = ThisWorkbook.Worksheets("Tabelle3")
 Set oFT = Range("Feiertage")
 
 With ThisWorkbook.Worksheets("Tabelle1").Range("A1")
   If Not .Value Like "MAT####" Then
     MsgBox "Die Materialnummer '" & .Value & "' ist falsch!" & vbLf & vbLf _
            & "Bitte eine vollständige Materialnummer eingeben!", _
              vbExclamation, "Falsche Materialnummer"
     Exit Sub
   End If
   On Error Resume Next
   iGefunden = 0
   iGefunden = Application.WorksheetFunction.Match(.Value, WSh.Range("A:A"), 0)
   If iGefunden > 0 Then
      Lieferdatum = WorksheetFunction.WorkDay(Date + WSh.Cells(iGefunden, "B").Value - 1, _
                    1, Range("Feiertage"))
      .Offset(1, 0).Value = "Die " & .Value & " wird geliefert am " & Lieferdatum
  Else
      MsgBox "Diese Materialnummer wurde nicht gefunden!", vbCritical, "Lieferzeit holen"
  End If
 End With
End Sub

______________________
viele Grüße aus Freigericht
Karl-Heinz

[MaMü11]

Vielen Dank euch beiden für die große Hilfe  :18:

Die Workday Funktion ist glaube ich etwas anders aufgebaut, oder? Also ich habe jetzt „WorksheetFunction.WorkDay(Date, WSh.Cel...., Range(„Feiertage“).