Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
hi! I have a udf that uses a help udf. The main udf reads one or more ranges
and then sorts through them with the us eof the help. it returns a single value (eg. AA+). The code works just fine but I had to change it because if the cells that are taking in as argument are not beside each other (ie they are disjunct ranges) then the code does not work. thus, i tried to solve this by adding to optional ranges (there can never be more than 3 ranges). But now the code does not work. So there is something wrong with the ranges in the beginning but I cannot see where the problem is. please help me! Thanks alot! Function basel(Rating1 As Range, Optional Rating2 As Range, Optional Rating3 As Range) As String 'Funktionen skapad 2007-04-18 av Anders Rydén 'denna funktion tar fram den rating som skall väljas enligt de Basel-regler som RB använder. 'Denna funktion använder en hjälpfunktion för att fungera. Hjälpfunktionen finns nedan. Dim i As Long Dim j As Long Dim k As Long Dim A() As String Dim Rating() As String Dim RatingScale As Variant Dim MdyRatingScale As Variant If Rating1 Is Empty Then For i = 1 To Rating1.Columns.Count ReDim Preserve Rating(1 To i) Rating(i) = Rating1(i) Next End If MsgBox "jhv" If Rating2 Is Not Empty Then For i = UBound(Rating) To (UBound(Rating) + Rating2.Columns.Count) ReDim Preserve Rating(i) Rating(i) = Rating2(i) Next End If RatingScale = Array("AAA", "AA+", "AA", "AA-", "A+", "A", "A-", "BBB+", "BBB", "BBB-") 'ok SP och Fitch rating MdyRatingScale = Array("Aaa", "Aa1", "Aa2", "Aa3", "A1", "A2", "A3", "Baa1", "Baa2", "Baa3") 'ok Moodys rating i = 1 'räknare för kolumner j = 1 'räknare för ratingbetyg k = 0 'räknare för antal celler med godkänd rating For i = 1 To UBound(Rating) 'kollar varje kolumn för sig For j = 1 To UBound(RatingScale) 'kollar varje OK rating If (Rating(i) = RatingScale(j) Or Rating(i) = MdyRatingScale(j)) Then k = k + 1 ReDim Preserve A(k) 'dimensionera om A A(k) = j 'de får samma sifferbetyg som i ratingens placering i arrayen End If Next j Next i If k < 0 Then 'om det finns några godkända celler 'här väljs vilken rating som skall användas 'om det endast finns en så skall denna användas If UBound(A) = 1 Then basel = RatingScale(A(1)) End If 'om det finns två skall man ta den med lägst If UBound(A) = 2 Then If A(1) A(2) Then basel = RatingScale(A(1)) Else basel = RatingScale(A(2)) End If End If 'om det finns tre eller fler ska man ta de två högsta och om de är olika den lägsta av dem. If UBound(A) = 3 Then SortArray A 'går till funktion som sorterar arrayen basel = RatingScale(A(2)) 'väljer ut näst högsta i arrayen End If ElseIf k = 0 Then 'om det ej finns några godkända celler basel = "n/a" End If End Function Function SortArray(ByRef TheArray As Variant) 'Skapad av Anders Rydén 2007-04-19 'Detta är en hjälpfunktion till den huvudfunktion som tar fram rärr rating enligt Basel-reglerna. 'sorterar arrayen efter storlek Dim Sorted As Boolean Dim X As Long Dim B As String Dim temp Sorted = False Do While Not Sorted Sorted = True For X = LBound(TheArray) To UBound(TheArray) - 1 If TheArray(X) TheArray(X + 1) Then temp = TheArray(X + 1) TheArray(X + 1) = TheArray(X) TheArray(X) = temp Sorted = False End If Next X Loop End Function |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
how copy formula that contains ranges so ranges do not overlap | Excel Worksheet Functions | |||
union of named ranges based only on the names of those ranges | Excel Programming | |||
Copy data in named ranges to a newer version of the same template to identical ranges | Excel Programming | |||
Counting variable ranges and auto-summing variable ranges | Excel Programming | |||
named ranges - changing ranges with month selected | Excel Programming |