02. november 2007 - 13:36
Der er
2 kommentarer og
1 løsning
For Each Next, ListBox værdier, variabeltyper
Hjælp
Jeg har gevaldige problemer med en løkke. Har ikke styr på hvornår der skal benyttes text eller value egenskaber og hvilken variabeltype jeg skal vælge. Desuden hvorledes jeg henter forskellige talværdier fra en Range (brug af Offset ?) Læg hertil fumleri med If, End If, Next i en For Each Next løkke og i har en knækket mand.
Forløb:
- Klik på CMD på UserForm
- Hvis ChkBox1 og OptButtonA er True:
For hver celle i Range ”TrayGalvanized” på Sheet ”DripTray” skal der kontrolleres om den tekstbeskrivelse som bruger har valgt i LstBoxNonStd på UserFormen findes. Bmrk tekstbeskrivelserne som skal sammenlignes er angivet i LstBoxNonStd første kolonne ”Ramme” og i Rangen ”TrayGalvanized” kolonne nr 1 .
LstBoxNonStd er defineret sådan:
Ramme = LstBoxNonStd.Column(0)
Kon = LstBoxNonStd.Column(1)
Tekn = LstBoxNonStd.Column(2)
PartRef = LstBoxNonStd.Column(3)
BasicPrice = LstBoxNonStd.Column(4)
AFactor = LstBoxNonStd.Column(5)
- Hvis teksten i LstBoxNonStd.Column(0) ikke findes i Rangen ”Tray Galvainzed” skal en MsgBox melde ”Det I listboksen valgte produkt findes ikke I Rangen” . Herefter kan proceduren stoppe
-Hvis teksten i LstBoxNonStd.Column(0) findes I Rangens ”Tray Galvainzed” skal der fra samme linie i Rangen benyttes talværdier fra kolonne nr 5 og nr 6 i denne beregning:
TextBoxCostDrip.Value = (tal fra kolonne 5 + 1205) * tal fra kolonne 6
TxtBoxSalesTray.Value = ((tal fra kolonne 5 + 1205) * tal fra kolonne 6) * TextBoxNonStdOH.Value
Kunne man benytte en kode a la:
Sub test ()
Dim C As Range
Dim Ramme As String
Dim ….
Dim...
If CheckDrip.Value = True And OptGalvanized.Value = True Then
For Each C In Worksheets "DripTray").Range "TrayGalvanized").Cells
If C.Text = Ramme Then
TextBoxCostDrip.Value = (tal fra kolonne 5 + 1205) * tal fra kolonne 6
TxtBoxSalesTray.Value = ((tal fra kolonne 5 + 1205) * tal fra kolonne 6) * TextBoxNonStdOH.Value
Exit For
End If
If C.Value = " " Then ’Hvis teksten ikke findes
MsgBox " Det I listboksen valgte produkt findes ikke I Rangen”
Exit For
End If
Next C
End If
End Sub
08. november 2007 - 23:24
#3
Uddrag af koden - justeret:
'Beregn priser for Non Std Isolering og Drypbakker
Private Sub CmdCalcNonStd_Click()
Dim Ramme As String
Rem Test om der er valgt i LstBoxNonStd
If Me.LstBoxNonStd.ListIndex <> -1 Then
' Definer værdier i listen - Kortere notation F/NEDENSTÅENDE Me = userformen - bemærk "."
With Me.LstBoxNonStd
Ramme = .Column(0)
Kon = .Column(1)
Tekn = .Column(2)
PartRef = .Column(3)
BasicPrice = .Column(4)
AFactor = .Column(5)
End With
'Datavalidering af tekstboks A Measure
TextBoxAMeasure = Replace(TextBoxAMeasure, ".", ",")
If Not IsNumeric(TextBoxAMeasure) Or TextBoxAMeasure.Value = " " Then 'hvis ikke der står et numerisk tal i tekstboksen så..
MsgBox "Enter a value in the Text Box A Measure"
TextBoxAMeasure.SetFocus
Exit Sub
End If
'Datavalidering af tekstboks Overhead
TextBoxNonStdOH = Replace(TextBoxNonStdOH, ".", ",")
If Not IsNumeric(TextBoxNonStdOH) Or TextBoxNonStdOH.Value = " " Then 'hvis ikke der står et numerisk tal i tekstboksen så..
MsgBox "Enter a value in the Text Box Financial Overhead"
TextBoxNonStdOH.SetFocus
Exit Sub
End If
'Beregning af CostPriceNonStdInsulation
TextBoxCostNonStdInsulation = BasicPrice + TextBoxAMeasure * AFactor
'Beregning af SalesPriceNonStdInsulation
TextBoxSalesNonStdInsul = TextBoxCostNonStdInsulation * TextBoxNonStdOH
'Beregning af Priser for DripTray Galvanized
If CheckDrip.Value = True And OptGalvanized.Value = True Then
addr = Worksheets("DripTray").Range("TrayGalvanized").Address
fraræk = udtrækRække(addr, False)
tilræk = udtrækRække(addr, True)
For Ræk = fraræk To tilræk
If Cells(Ræk, 1) = Ramme Then 'hvis celleværdien er samme som værdi i den første kolonne i LstBoxCostDrip
TextBoxCostDrip.Value = Cells(Ræk, 4) ' + (TextBoxAMeasure.Value * C.Cells(ræk, 6)) 'udregning af kostpris
TxtBoxSalesTray.Value = Cells(Ræk, 5) '+ (TextBoxAMeasure.Value * C.Cells(ræk, 6)) * TextBoxNonStdOH 'udregning af salgspris
Exit Sub
End If
Next Ræk
End If
'Beregning af Priser for DripTray AISI304
If CheckDrip.Value = True And OptAISI304 = True Then
addr = Worksheets("DripTray").Range("Tray304").Address
fraræk = udtrækRække(addr, False)
tilræk = udtrækRække(addr, True)
For Ræk = fraræk To tilræk
If Cells(Ræk, 1) = Ramme Then 'hvis celleværdien er samme som værdi i den første kolonne i LstBoxCostDrip
TextBoxCostDrip.Value = Cells(Ræk, 4) ' + (TextBoxAMeasure.Value * C.Cells(ræk, 6)) 'udregning af kostpris
TxtBoxSalesTray.Value = Cells(Ræk, 5) '+ (TextBoxAMeasure.Value * C.Cells(ræk, 6)) * TextBoxNonStdOH 'udregning af salgspris
Exit Sub
End If
Next Ræk
End If
End If
Rem Hvis match ikke findes - "lander" processen her - derfor ingen If
' If Cells(Ræk, 1) = " " Then 'hvis værdien af den første kolonne i LstBoxNonStd ikke findes i Range
MsgBox "The product choosen in the list is not created in the selected Range .Please remove Check in the box Include Drip Tray"
' End If
End Sub
Private Function udtrækRække(adr, del)
p = InStr(adr, ":")
If p > 0 Then
If del = False Then
udtrækRække = Range(Left(adr, p - 1)).Row
Else
udtrækRække = Range(Mid(adr, p + 1)).Row
End If
Exit Function
Else
Stop 'system-fejl : mangler i adresse
End If
End Function
