LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
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
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how copy formula that contains ranges so ranges do not overlap Patty Excel Worksheet Functions 1 November 20th 08 04:15 PM
union of named ranges based only on the names of those ranges sloth Excel Programming 3 October 2nd 06 03:18 AM
Copy data in named ranges to a newer version of the same template to identical ranges handstand Excel Programming 0 August 21st 06 03:51 PM
Counting variable ranges and auto-summing variable ranges Father Guido[_5_] Excel Programming 2 March 29th 06 04:07 AM
named ranges - changing ranges with month selected gr8guy Excel Programming 2 May 28th 04 04:50 AM


All times are GMT +1. The time now is 04:15 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"