Thread: ranges
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Arne Hegefors Arne Hegefors is offline
external usenet poster
 
Posts: 244
Default ranges

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