Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA: Suchen in Datenbank
#1
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
Antwortento top
#2
Hallöchen,

könnte Dir nicht auch der SVERWEIS reichen?
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#3
Hi, ich denke nicht, da ich die Funktionen wahrscheinlich noch erweitern muss und dann hätte ich alles am Liebsten in VBA
Antwortento top
#4
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
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antwortento top
#5
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
Antwortento top
#6
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?
Antwortento top
#7
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
Antwortento top
#8
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
Wink

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Benutzer sagt Danke an RPP63 für diesen Beitrag:
  • Fred11
Antwortento top
#9
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
Antwortento top
#10
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“).
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste