Tabelle sinnig verkürzen

[elamigo]

Hey Leute,

anbei eine Bsp-Datei. Ich such ein Worksheet-Activate Event um die Einträge in der Tabelle nach der Reihe von Zeile 9 an zu ordnen. Also in B9 soll dann "toll" stehen und in B10 "super". Einfach das die Einträge schön unter einander sind. 
Die Einträge kommen durch Verknüpfungen so quer in die Tabelle.

[Elex]

Hi

Wäre es dann nicht sinnvoll den Code hier gleich so zu schreiben dass der Reihe nach ausgefüllt wird?
https://www.clever-excel-forum.de/thread-19594.html

Gruß Elex

[RPP63]

Moin!
Eine Möglichkeit:

Sub Sortieren()
With Tabelle9
  .Range("B9:B36").Sort .Range("B9"), xlDescending
  .Range("D9:D36").Sort .Range("D9"), xlDescending
End With
End Sub

Gruß Ralf

[elamigo]

Sorry, der hat meine Antwort von heute morgen nicht gepostet...


@Elex, dieser Wunsch kam auch erste sehr kurzfristig auf mich zu. 


@Ralf, geht leider in dieser Form nicht bei mir.

[RPP63]

@Ralf, geht leider in dieser Form nicht bei mir.

Der soll ja auch nicht gehen, sondern lediglich funktionieren, was "er" bei mir anstandslos tut.
Etwas genauer?

[elamigo]

Code:

Sub Schaltfläche2_Klicken()
   Range("B9:B36").Select
   ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort.SortFields.Add Key:= _
       Range("B9"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
       xlSortNormal
   With ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort
       .SetRange Range("B9:B36")
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
   Range("D9:D36").Select
   ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort.SortFields.Add Key:= _
       Range("D9"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
       xlSortNormal
   With ActiveWorkbook.Worksheets("Notes Sighting-Round").Sort
       .SetRange Range("D9:D36")
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
End Sub

das spuckt mir das Makro aus, geht easy als Schaltfläche, aber als Worksheet_activate Event, gibt es direkt ein Fehler und der debugger macht die erste Zeile gelb.

[Elex]

Hi

@Elex, dieser Wunsch kam auch erste sehr kurzfristig auf mich zu.

Ja und ist jetzt deshalb eine Änderung am anderen Code nicht möglich oder Funktionell nicht machbar?
 
Zum Verständnis deines neuen Wunsches. Du möchtest keine Sortierung sondern nur ein Zusammenrutschen der Inhalte (leere Zellen weg) Oder?

Gruß Elex

[elamigo]

ja zusammen rücken der Ergebnisse. Allerdings sind im Orginal noch Notizen in Spalte G, sieht hier gelb markiert. 
Daher keine Ahnung Ob du mit zusammen rücken Zeilen löschen meinst.

[RPP63]

das spuckt mir das Makro aus, geht easy als Schaltfläche, aber als Worksheet_activate Event, gibt es direkt ein Fehler und der debugger macht die erste Zeile gelb.

Was genau hat jetzt Dein Rekorder-Code mit meinem Zweizeiler zu tun?
Du könntest im Activate den selben Code nutzen, allerdings wäre Tabelle9 im Klassenmodul der Tabelle gleichbedeutend mit Me, also redundant.

Gruß Ralf

[Elex]

Hi

Code:

Private Sub Worksheet_Activate()
Dim arrWerteB(1 To 28, 0) As Variant, arrWerteD(1 To 28, 0) As Variant
Dim i As Long, b As Long, d As Long
b = 1
d = 1
For i = 9 To 36
   If Cells(i, 2) <> "" Then
      arrWerteB(b, 0) = Cells(i, 2).Value
      b = b + 1
   End If
   If Cells(i, 4) <> "" Then
      arrWerteD(d, 0) = Cells(i, 4).Value
      d = d + 1
   End If
   
Next i
Range("B9:B36").Value = arrWerteB
Range("D9:D36").Value = arrWerteD
End Sub