Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1368to1372
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

:large funktion und dazugehörige Row bestimmen und

:large funktion und dazugehörige Row bestimmen und
17.07.2014 18:22:31
Bart

hallo alle zusemmen,
Ich bräuchte eure hilfe. Ich habe eine Liste von Zahlen in einem Worksheet und möchte die 50 grössten Werte ermitteln. Jedoch will ich nicht nur die Werte haben sondern die dazugehörige Row, diese dann kopieren und in ein anderes Sheet kopieren. Bis hierhin bin ich gekommen und ich denke es ist einiges falsch in meinem code. Ich kann einfach nicht von dem Wert der bei .Large ermittelt wird die dazugehörige Row ermitteln um diese zu kopieren.
Option Explicit
Sub MaxValues()
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet
Dim R As Range
Dim Max As Double
Dim MaxReihe As Double
Dim n As Double
Dim s As Double
Dim Count As Double
ThisWorkbook.Worksheets.Add
Set Wks1 = ActiveWorkbook.Sheets(2)
Set Wks2 = ActiveWorkbook.Sheets(1)
MaxReihe = 50
Application.ScreenUpdating = False
With Wks1
For n = 1 To MaxReihe
Wks1.Activate
Max = Application.WorksheetFunction.Large(Wks1.Range("D2:D" & Cells(Rows.Count, 1).End(xlUp)), n)
Count = WorksheetFunction.Match(Max)
Wks1.Rows(Count, 4) = Wks1.Activate
Wks1.EntireRow.Copy
Wks2.Activate
With Selection
Wks2.Paste
End With
ActiveCell.Offset(1, 0).Select
Next n
End With
Bitte Bitte hílft jemand ich verzweifle nämlich und habe langsam den Verdacht dass ich den falschen Ansatz wähle.
Dank Bart

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: :large funktion und dazugehörige Row bestimmen und
18.07.2014 11:26:10
UweD
Hallo
Hier eine Abänderung deines Makros.
!! Wichtig: es dürfen die einzelnen Werte NICHT mehrfach vorkommen, da über den MATCH immer das erste Vorkommen gefunden wird und dementsprechend auch immer diese Zeile kopiert wird.
Sonst muss man ggf über FIND arbeiten und xmal suchen...
Option Explicit
Sub MaxValues()
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet
Dim Max As Double
Dim MaxReihe As Double
Dim n As Double
Dim s As Double
Dim Count As Double
Dim Rng As Range
Dim LR As Long
Application.ScreenUpdating = False
Set Wks1 = ActiveWorkbook.Sheets(1) ' das ursprüngliche Blatt
ThisWorkbook.Worksheets.Add after:=ActiveWorkbook.Sheets(Sheets.Count)
Set Wks2 = ActiveWorkbook.ActiveSheet ' Das neue Blatt
s = 1 'erste Zielzeile
MaxReihe = 50
With Wks1
LR = .Cells(Rows.Count, 4).End(xlUp).Row 'letzte Zeile der Spalte 4=D
Set Rng = .Range("D1:D" & LR)
For n = 1 To MaxReihe
Max = WorksheetFunction.Large(Rng, n)
Count = WorksheetFunction.Match(Max, Rng, 0)
.Rows(Count).Copy Wks2.Rows(s)
s = s + 1
Next n
End With
Wks2.Activate
End Sub
Gruß UweD

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige