Wie kann ich es Regeln, wenn jetzt z.B. 1532 eigegeben wird, die Tabelle aber nur 1500 oder 1600 aufweist. Der Wert soll aber von der Spalte "1600" genommen werden.
Danke schon mal für eine Hilfe.
Private Function GetHundred(Value as Long) as Long
GetHundred = Mid(cStr(Value),1,Len(cStr(Value))-2) & "00"
End Function
Private Sub CommandButton1_Click()
Dim ZelleBreite As Range 'Suchbereich für Breite
Dim ZelleTiefe As Range 'Suchbereich für Tiefe
Dim sBreite As String 'gesuchte Breite
Dim sTiefe As String 'gesuchte Tiefe
sBreite = TextBox1.Value
sTiefe = TextBox2.Value
'Suchbereich für Breite ist die Zeile 1. Bei Bedarf veränderbar!
Set ZelleBreite = Worksheets("Tabelle1").Rows(6).Find(sBreite, lookat:=xlWhole)
'Suchbereich für Tiefe ist die Spalte 1. Bei Bedarf veränderbar!
Set ZelleTiefe = Worksheets("Tabelle1").Columns(17).Find(sTiefe, lookat:=xlWhole)
If ZelleBreite Is Nothing Then
MsgBox "Breite nicht vorhanden!"
Exit Sub
End If
If ZelleTiefe Is Nothing Then
MsgBox "Tiefe nicht vorhanden!"
Exit Sub
End If
'Schnittpunkt wird in TextBox3 ausgegeben
'TextBox3.Value = Cells(ZelleTiefe.Row, ZelleBreite.Column).Value
Range("O3").Value = Cells(ZelleTiefe.Row, ZelleBreite.Column).Value
End Sub
Sub test()
Dim a As Long, b As Long
a = 1532
b = Application.WorksheetFunction.RoundUp(a, -2)
End Sub
Sub Preis_ermitteln()
Dim Tiefe, Breite, Spalte, Reihe As Long
Dim PreisTab As Range
'--- Preistablle Festlegen
Set PreisTab = Sheets("Tabelle1").Range("A1:F5")
'--- Werte eingeben und auf Hunderter aufrunden
Tiefe = InputBox("Tiefe?")
Breite = InputBox("Breite?")
Tiefe = WorksheetFunction.RoundUp(Tiefe, -2)
Breite = WorksheetFunction.RoundUp(Breite, -2)
'--- Länge und Breite in Tabelle suchen
On Error GoTo Fehler
Reihe = WorksheetFunction.Match(Tiefe, PreisTab.Columns(1), 0)
Spalte = WorksheetFunction.Match(Breite, PreisTab.Rows(1), 0)
On Error GoTo 0
'--- Preis ermitteln
MsgBox ("Preis ist:" & PreisTab.Cells(Reihe, Spalte).Text)
End
'--- Fehlerbehandlung
Fehler:
MsgBox ("Ihre eingegebnen Größen konnten nicht gefunden werden.")
End Sub
Private Sub CommandButton1_Click()
Call test
End Sub
Private Sub TextBox1_AfterUpdate()
TextBox3.Text = ""
TextBox3.Enabled = False
If CommandButton1.Enabled = False Then
TextBox1.SetFocus
Exit Sub
End If
If TextBox1.Text = Empty Or Not IsNumeric(TextBox1.Value) Then
MsgBox "Nur Zahlen eingeben!"
ElseIf CLng(TextBox1.Value) <= Worksheets("Tabelle1").Cells(1, 2).Value - 100 Then
MsgBox "Mindestwert für Breite in Tabelle = " & Worksheets("Tabelle1").Cells(1, 2).Value - 99
ElseIf CLng(TextBox1.Value) > Worksheets("Tabelle1").Cells(1, 2).End(xlToRight).Value Then
MsgBox "Maximalwert für Breite int Tabelle = " _
& Worksheets("Tabelle1").Cells(1, 2).End(xlToRight).Value
Else
CommandButton1.Enabled = True
End If
End Sub
Private Sub TextBox2_AfterUpdate()
CommandButton1.Enabled = False
If TextBox2.Text = Empty Or Not IsNumeric(TextBox2.Value) Then
MsgBox "Nur Zahlen eingeben!"
ElseIf CLng(TextBox2.Value) <= Worksheets("Tabelle2").Cells(2, 1).Value - 100 Then
MsgBox "Mindestwert für Tiefe in Tabelle = " & Worksheets("Tabelle1").Cells(2, 1).Value - 99
ElseIf CLng(TextBox2.Value) > Worksheets("Tabelle1").Cells(2, 1).End(xlDown).Value Then
MsgBox "Maximalwert für Tiefe in Tabelle = " _
& Worksheets("Tabelle1").Cells(2, 1).End(xlDown).Value
Else
CommandButton1.Enabled = True
End If
End Sub