Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
ranges
I saw your problem yester. It is much clearer now that yuo showed the
program. why don't you use a Union satement to create the ranges ratther than use an array. go back to your original code that worked. Then create a new range that is a union of your disjunct cells. "Arne Hegefors" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
ranges
hi Joel! Thanks alot for your help. I think you are on the right track here.
However I still cannot get it to work. Can you see if I have done something wrong? Function basel(Rating1 As Range, Optional Ratings2 As Range, Optional ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Ratings2 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings2")) End If If ratings3 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings3")) 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 Rating.Columns.Count '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 Thanks alot for all your help!!!!!!! "Joel" skrev: I saw your problem yester. It is much clearer now that yuo showed the program. why don't you use a Union satement to create the ranges ratther than use an array. go back to your original code that worked. Then create a new range that is a union of your disjunct cells. "Arne Hegefors" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
ranges
I made some changes to get rid of the errors. Also added a testt driver to
check the code. In some plces you had an S in Ratings1 and other places you left out the S. Sub test() Set Rating1 = Range("A1:C3") Set Rating2 = Range("D1:F3") abc = basel(Rating1, Rating2) End Sub Function basel(ByVal Ratings1 As Range, Optional ByVal Ratings2 As Range, _ Optional ByVal ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Not Ratings2 Is Nothing Then Set Ratings = Union(Ratings, Ratings2) End If If Not ratings3 Is Nothing Then Set Ratings = Union(Ratings, ratings3) 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 Ratings.Columns.Count 'kollar varje kolumn för sig For j = 1 To UBound(RatingScale) 'kollar varje OK rating If (Ratings(i) = RatingScale(j) Or Ratings(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 "Arne Hegefors" wrote: hi Joel! Thanks alot for your help. I think you are on the right track here. However I still cannot get it to work. Can you see if I have done something wrong? Function basel(Rating1 As Range, Optional Ratings2 As Range, Optional ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Ratings2 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings2")) End If If ratings3 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings3")) 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 Rating.Columns.Count '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 Thanks alot for all your help!!!!!!! "Joel" skrev: I saw your problem yester. It is much clearer now that yuo showed the program. why don't you use a Union satement to create the ranges ratther than use an array. go back to your original code that worked. Then create a new range that is a union of your disjunct cells. "Arne Hegefors" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
ranges
Hi! Thanks Joel! You are really helping me! Now the problem seems to be the
fact that the array A only has Ubound = 1. Somehow only the lowest rating is shown as basel. It does not matter if it is at the beginning or the end but Ubound(a) is always equal to 1 and the lowest rating is always shown as basel. I do not know how that can be. Do you have any idea? "Joel" skrev: I made some changes to get rid of the errors. Also added a testt driver to check the code. In some plces you had an S in Ratings1 and other places you left out the S. Sub test() Set Rating1 = Range("A1:C3") Set Rating2 = Range("D1:F3") abc = basel(Rating1, Rating2) End Sub Function basel(ByVal Ratings1 As Range, Optional ByVal Ratings2 As Range, _ Optional ByVal ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Not Ratings2 Is Nothing Then Set Ratings = Union(Ratings, Ratings2) End If If Not ratings3 Is Nothing Then Set Ratings = Union(Ratings, ratings3) 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 Ratings.Columns.Count 'kollar varje kolumn för sig For j = 1 To UBound(RatingScale) 'kollar varje OK rating If (Ratings(i) = RatingScale(j) Or Ratings(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 "Arne Hegefors" wrote: hi Joel! Thanks alot for your help. I think you are on the right track here. However I still cannot get it to work. Can you see if I have done something wrong? Function basel(Rating1 As Range, Optional Ratings2 As Range, Optional ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Ratings2 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings2")) End If If ratings3 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings3")) 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 Rating.Columns.Count '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 Thanks alot for all your help!!!!!!! "Joel" skrev: I saw your problem yester. It is much clearer now that yuo showed the program. why don't you use a Union satement to create the ranges ratther than use an array. go back to your original code that worked. Then create a new range that is a union of your disjunct cells. "Arne Hegefors" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
ranges
I would try this
For Each cell In Ratings 'kollar varje kolumn för sig For j = 1 To UBound(RatingScale) 'kollar varje OK rating stu = UBound(RatingScale) If (cell = RatingScale(j) Or cell = 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 Ratings "Arne Hegefors" wrote: Hi! Thanks Joel! You are really helping me! Now the problem seems to be the fact that the array A only has Ubound = 1. Somehow only the lowest rating is shown as basel. It does not matter if it is at the beginning or the end but Ubound(a) is always equal to 1 and the lowest rating is always shown as basel. I do not know how that can be. Do you have any idea? "Joel" skrev: I made some changes to get rid of the errors. Also added a testt driver to check the code. In some plces you had an S in Ratings1 and other places you left out the S. Sub test() Set Rating1 = Range("A1:C3") Set Rating2 = Range("D1:F3") abc = basel(Rating1, Rating2) End Sub Function basel(ByVal Ratings1 As Range, Optional ByVal Ratings2 As Range, _ Optional ByVal ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Not Ratings2 Is Nothing Then Set Ratings = Union(Ratings, Ratings2) End If If Not ratings3 Is Nothing Then Set Ratings = Union(Ratings, ratings3) 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 Ratings.Columns.Count 'kollar varje kolumn för sig For j = 1 To UBound(RatingScale) 'kollar varje OK rating If (Ratings(i) = RatingScale(j) Or Ratings(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 "Arne Hegefors" wrote: hi Joel! Thanks alot for your help. I think you are on the right track here. However I still cannot get it to work. Can you see if I have done something wrong? Function basel(Rating1 As Range, Optional Ratings2 As Range, Optional ratings3 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 B As String Dim Ratings As Range Dim RatingScale As Variant Dim MdyRatingScale As Variant Set Ratings = Ratings1 If Ratings2 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings2")) End If If ratings3 Is Not Empty Then Set Ratings = Union(Range("Ratings"), Range("Ratings3")) 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 Rating.Columns.Count '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 Thanks alot for all your help!!!!!!! "Joel" skrev: I saw your problem yester. It is much clearer now that yuo showed the program. why don't you use a Union satement to create the ranges ratther than use an array. go back to your original code that worked. Then create a new range that is a union of your disjunct cells. "Arne Hegefors" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
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 |