AW: Wert größer aus Tabelle
08.10.2006 17:34:06
Gerd
Hallo,
ad eins: "Shit happens" :-)
ad zwo: Ich plädiere dafür, Fehler bei der Eingabe abzufangen.
Falls es noch jemanden interessiert, da ich mich mit der Sache beschäftigt habe.
Teststellung:
Eine "Userform1" mit den Textboxen "Textbox1"(Breite),"Textbox2"(Tiefe),Textbox3(Preis),
u. dem Commandbutton1(zum Starten der Preisermittlung).
Eine Datei mit "Tabelle1", in der von Zelle "A2" abwärts in Spalte "A" die Tiefen
und von Zelle "B1" nach rechts in Zeile 1 die Breiten stehen u. in den
Zellen "dazwischen" die Preise.
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
Sub test()
'in ein Standardmodul
Dim lngBreite As Long
Dim lngTiefe As Long
Dim wsPreise As Worksheet
Dim intLetzteBreitenSpalte As Integer
Dim lngLetzteTiefenZeile As Long
Dim rngBreite As Range
Dim rngTiefe As Range
Dim intColBreite As Integer
Dim lngRowTiefe As Long
Dim curPreis As Currency
If UserForm1.TextBox1 = Empty Or UserForm1.TextBox2 = Empty Then Exit Sub
lngBreite = Application.WorksheetFunction.RoundUp(CLng(UserForm1.TextBox1.Text), -2)
lngTiefe = Application.WorksheetFunction.RoundUp(CLng(UserForm1.TextBox2.Text), -2)
Set wsPreise = ThisWorkbook.Worksheets("Tabelle1")
intLetzteBreitenSpalte = wsPreise.Range("B1").End(xlToRight).Column
Set rngBreite = wsPreise.Range(wsPreise.Cells(1, 2), wsPreise.Cells(1, intLetzteBreitenSpalte))
intColBreite = wsPreise.Range(rngBreite.Address).Find(lngBreite).Column
lngLetzteTiefenZeile = wsPreise.Range("A2").End(xlDown).Row
Set rngTiefe = wsPreise.Range(wsPreise.Cells(2, 1), wsPreise.Cells(lngLetzteTiefenZeile, 1))
lngRowTiefe = rngTiefe.Find(lngTiefe).Row
curPreis = CCur(wsPreise.Cells(lngRowTiefe, intColBreite).Value)
UserForm1.TextBox3.Text = CStr(Format(curPreis, "#,##0.00 €"))
End Sub
Grüße
Gerd