02. november 2007 - 13:36Der 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
'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
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
