Top Ten

Forumthread: Top Ten

Top Ten

07.08.2003 10:56:18

Bob

Hallo Leute,
hoffe ihr könnt mir helfen. Also ich habe pro Fußball-Mannschaft ein Worksheet (also gesamt 18) genommen und dort die Torschützen absteigend sortiert. (Spalte A: Toranzahl, Spalte B: Torschütze)
z.b. für Amberg
3____Rudert
1____Seidl
1____Liermann
Nun will ich durch VBA die besten zehn Torschützen der Liga anzeigen lassen, wieder in einem extra Worksheet, und zwar bei CommandButton click. Hat da jemand eine Idee? Wäre eine super Sache...(hab leider in der Recherche nichts derartiges gefunden)
Danke für euer Bemühen
Bob

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Top Ten

07.08.2003 11:36:17

Ulf
AW: Top Ten

07.08.2003 11:37:37

ivan
AW: Top Ten

07.08.2003 11:57:15

Lothar
Danke!!!!

07.08.2003 12:40:44

Bob

AW: Top Ten

07.08.2003 11:36:17

Ulf

Ja müßte sogar mit Makrorecorder laufen.
Alle Spieler in die Torschützenliste kopieren und dann sortieren.
Danach löschst Du einfach alle Zeilen nach der 10.
Ich denkeb thats it und wie gesagt sollte mit Makrorekorder auch laufen.

AW: Top Ten

07.08.2003 11:37:37

ivan

Hallo Bob Herzliche Grüsse von Ivan Gesund Bleiben Gesund werden www.Tepperwein-Collection.at

ich gehe davon aus das es keine kopfzeile gibt!
und  eine Tabbele3
Option Explicit
Private Sub CommandButton1_Click()
     'Top10 sortiern
    Columns("A:B").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
     ' tabelle1 A1:B10  nach Tabelle3 kopieren
    Range("A1:B10").Select
    Selection.Copy
    Sheets("Tabelle3").Select
     ActiveSheet.Paste
End Sub

Hallo Bob!
Hier der komplette Source Code:
Voraussetzung: Das 1. Tabellenblatt heisst Steuerung (da war bei mir der TestButtom drauf :) der das Makro aufruft.


Sub KopierenSortierenFilternAusgeben()
Dim iCounter As Integer, iRow As Integer, nName as String
Application.ScreenUpdating = False
Sheets("Steuerung").Select
nName = "TopTen"
Blattname = nName
For Each Blatt In Sheets
If Blatt.Name = Blattname Then
Sheets("Steuerung").Select
If MsgBox( _
prompt:="Das Blatt " & nName & " exisitert schon!" & Chr(13) & Chr(10) & "NEIN = Weiterverarbeitung abbrechen!" & Chr(13) & Chr(10) & "JA = Update! (Löschung vorhandenes Blatt, Ersetzung mit neuen Daten!)", _
Buttons:=vbQuestion + vbYesNo + vbDefaultButton2 _
) = vbNo Then Exit Sub
Sheets(nName).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Next
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nName
iRow = 1
For iCounter = 2 To 4 ' hier muss bei 18 Blättern natürlich 19 stehen !!
Worksheets(iCounter).Range("A1").CurrentRegion.Copy _
Cells(iRow, 1)
iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Next iCounter
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Tore"
Range("A1:B1").Select
Selection.Font.Bold = True
Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("B1").Select
Selection.AutoFilter Field:=2, Criteria1:="10", Operator:=xlTop10Items
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Top Ten

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread