Thema Datum  Von Nutzer Rating
Antwort
13.07.2010 22:51:31 Julian
NotSolved
Blau hier zwei Varianten
 17.07.2010 13:29:32 Tino
NotSolved

Ansicht des Beitrags:
Von:
Tino		 Datum:
17.07.2010 13:29:32		 Views:
705		 Rating:
     
Antwort:
  Ja
Thema:
hier zwei Varianten
Hallo,
teste mal ob es so geht, die Tabelle müsstest Du noch im Code anpassen.

'Version 1 _______________________________________
Sub Beispiel_1() 'mit Array
Dim ArrayBetrag(), ArrayRang()
Dim rngTmp As Range
Dim nCount As Long, lngMaxRow As Long

With Tabelle1 'Tabelle anpassen
Set rngTmp = .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))
ArrayBetrag = rngTmp.Value2

lngMaxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
If lngMaxRow > 1 Then
.Range("C2", Cells(lngMaxRow, 3)).ClearContents
End If

ReDim ArrayRang(1 To UBound(ArrayBetrag))

With Application.WorksheetFunction
For nCount = 1 To UBound(ArrayBetrag)
ArrayRang(nCount) = .Rank(ArrayBetrag(nCount, 1), rngTmp)
Next nCount
End With
.Range("C2", .Range("C2").End(xlDown)).ClearContents
.Range("C2").Resize(UBound(ArrayBetrag), 1) = Application.Transpose(ArrayRang)
End With
End Sub

'Version 2 _______________________________________
Sub Beispiel_2() 'mit Formel
Dim rngTmp As Range, lngMaxRow As Long

With Tabelle1 'Tabelle anpassen

Set rngTmp = .Range("B2", .Cells(lngMaxRow, 2).End(xlUp))

lngMaxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
If lngMaxRow > 1 Then
.Range("C2", Cells(lngMaxRow, 3)).ClearContents
End If

With rngTmp.Offset(0, 1)
.Formula = "=RANK(" & rngTmp(1, 1).Address(0, 0) & "," & rngTmp.Address(1, 1) & ")"
.Value = .Value
End With
End With

End Sub

Gruß Tino

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
13.07.2010 22:51:31 Julian
NotSolved
Blau hier zwei Varianten
 17.07.2010 13:29:32 Tino
NotSolved