zu umständlich, oder?
22.01.2007 20:42:54
Sophie
hab mir ein kleines Makro geschrieben, kann mir aber nicht helfen, glaube es ist ziemlich umständlich...oder was meint Ihr dazu?
Folgendes war mein Problem, habe eine Excel-Mappe die 12 Tabellenblätter enthält.
In jedem Tabellenblatt sind teilweise die gleichen Merkmale, können aber auch unterschiedlich viele Merkmale enthalten sein. Jedes Merkmal wird gekennzeichnet mit einer eindeutigen Nummer, sprich das Merkmal 10 in dem Tabellenblatt 1 ist das gleiche Merkmal wie in Tabellenblatt 2, wenn vorhanden.
Die Nummern stehen immer in der Spalte A allerdings nicht hintereinander, auch nicht sortiert, sind teilweise sehr viel leere Zeilen dazwischen bevor dann die nächste Nummer zu finden ist. Das Problem ist auch, daß es vorkommen kann, daß in Tabellenblatt 1-3 gleich viele Merkmale sind, dann ab Tabellenblatt 4 werden es mehr.
Nun brauche ich über die kompletten 12 Tabellenblätter eine vollzählige Auflistung sortiert, über alle Nummern die hier vorkommen. Die Nummern sind auch nicht aufsteigend, also wenn die 1. zu findente Nummer 10 ist, ist die zweite 20, dann vielleicht 21 oder 50 ganz unterschiedlich.
Hier mein Programm:
Option Explicit
Sub AnzahlMerkmale() Dim AM() As Long, j As Long, k As Long Dim i As Byte, l As Byte Dim Start As Double Dim m As Date 'Reservierung von 500 Werte ReDim AM(500) Start = Timer Debug.Print " gestartet um: " & Format(Now - m, "hh:mm:ss") 'Januar - Dezember For i = 1 To 12 Worksheets("Ausw.-Monat " & i).Select If i = 1 Then 'alle bewerteten Merkmale in Monat 1 erfassen um eine Basis zu schaffen For j = 1 To Range("A65536").End(xlUp).Row If Cells(j, 1) <> "" Then k = k + 1: AM(k) = Cells(j, 1) Next j Else 'ab Monat 2 überprüfen, ob weitere Merkmale hinzugekommen sind, wenn ja, diese dann hinzufügen For j = 1 To Range("A65536").End(xlUp).Row If Cells(j, 1) <> "" Then For l = 1 To k If Cells(j, 1) = AM(l) Then Exit For Next l If l > k Then k = k + 1: AM(k) = Cells(j, 1) End If Next j End If Next i 'wechseln zu leere Excelmappe indem sich auch das Makro befindet Windows("Merkmalerfassung.xls").Activate 'erfasste Merkmale sortieren For j = 1 To k Cells(j, 1) = AM(j) Next j Columns("A:A").Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'Datenfeld löschen und auf benötigte Anzahl dimensionieren ReDim AM(k) 'erneutes Einlesen der sortierten Merkmale For j = 1 To k AM(j) = Cells(j, 1) Next j Debug.Print " beendet um: " & Format(Now - j, "hh:mm:ss") Debug.Print Format(Timer - Start, "#0.00") & " Sekunden gerödelt!" End Sub
Schönen Gruß
Sophie