Excel 2013 VBA: Sortierproblem
#1
Hallo zusammen,

die in Excel eingebauten Sortiermethoden und Funktionen helfen mir gerade nicht so richtig weiter.
Vielleicht kann mir jemand von Euch weiterhelfen?

Ich will eine Tabelle sortieren die wie folgt aussieht und durch dieses Makro sortiert wurde:

D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.1_Adressen.xlsx
D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.2_Boot 2015.xlsx
D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\8.0_S_Tabelle.xls
D:\1_Mydaten_Aktiv\Office\Excel\Sport\G\5.0_Zählsystem_V1.xlsm
D:\1_Mydaten_Aktiv\Office\Excel\Sport\Mgmt\4.2_WTrain.xls
usw....

Sub sortiere()
 Application.ScreenUpdating = False
 Columns("A:A").Select
 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 Application.Goto Reference:=Range("A2"), Scroll:=True
End Sub

Die Tabelle sollte aber nach den Dateinamen sortiert werden unabhängig aus welchem Verzeichnis sie kommen, also so:
D:\1_Mydaten_Aktiv\Office\Excel\Sport\Mgmt\4.2_WTrain.xls
D:\1_Mydaten_Aktiv\Office\Excel\Sport\G\5.0_Zählsystem_V1.xlsm
D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.1_Adressen.xlsx
D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.2_B_2015.xlsx
D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\8.0_S_Tabelle.xls
usw...

Hat jemand eine Idee ob und wie das geht?
Vielen Dank!
Top
#2
Hallo!
Da Du ohnehin mit Makros arbeitest, hilft Dir folgende UDF in einer Hilfsspalte, die Du dann sortieren kannst:
Code:
Function TeilRechts(rng As String) As String
TeilRechts = Mid(rng, InStrRev(rng, "\") + 1, 9 ^ 9)
End Function
Funktioniert aber nur bei einstelligen Versionsnummern, da für Excel der Text "11" < "2" ist.

AB
1D:\1_Mydaten_Aktiv\Office\Excel\Sport\Mgmt\4.2_WTrain.xls4.2_WTrain.xls
2D:\1_Mydaten_Aktiv\Office\Excel\Sport\G\5.0_Zählsystem_V1.xlsm5.0_Zählsystem_V1.xlsm
3D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.1_Adressen.xlsx7.1_Adressen.xlsx
4D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\7.2_Boot 2015.xlsx7.2_Boot 2015.xlsx
5D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\8.0_S_Tabelle.xls8.0_S_Tabelle.xls
Formeln der Tabelle
ZelleFormel
B1=Teilrechts(A1)

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • sharky51
Top
#3
Hallo Ralf,

danke für Deinen Beitrag!

Wenn es geht möchte ich das ohne Hilfsspalte haben und der Verzeichnispfad sollte nach der Sortierung natürlich erhalten bleiben.
Top
#4
Hi!
Du kannst Dir doch die Formel temporär in die erste freie Spalte schreiben (per VBA), dann sortieren (per VBA) und dann die Hilfsspalte wieder löschen (per VBA). 
Wenn Du vorher Application.ScreenUpdating = False setzt, kriegst Du noch nichtmal was davon mit. Wink
Ich schreibe gleich mal den Code und stelle die Datei hier ein.

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Top
#5
Moin,

von der Idee her und mal laut überlegt:
  • Alle Daten in ein 1-dimensionales Array einlesen
  • Das Ganze in ein 2-dim. Array, 2. Spalte noch leer
  • Nun in die 2. Spalte alles nach dem letzten \ und dort alles vor dem 1. _ als numerischen Wert (dank Punkt-Trenner möglich) eintragen
  • Array nach 2. Spalte sortieren (Wie, das ist im www oft genug nachzulesen)
  • eventuell aus der neuen, sortierten 1. Spalte ein neues Array erzeugen
  • Die 1. Spalte zurück schreiben.
Beste Grüße
  Günther

Excel-ist-sexy.de
  …schau doch mal rein!
Der Sicherheit meiner Daten wegen lade ich keine *.xlsm bzw. *.xlsb- Files mehr herunter! -> So geht's ohne!
Top
#6
Da ich schon mal dran war:

Modul Modul1
Option Explicit 

Function TeilRechts(rng As String) As String
TeilRechts = Mid(rng, InStrRev(rng, "\") + 1, 9 ^ 9)
End Function

Sub Sortiere()
Dim ErsteFreieSpalte As Long
Dim LetzteZeile As Long
With Tabelle1
  ErsteFreieSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
  LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
  .Cells(1, ErsteFreieSpalte).Value = "ÜBtemp"
  .Range(.Cells(2, ErsteFreieSpalte), .Cells(LetzteZeile, ErsteFreieSpalte)).FormulaR1C1 = "=TeilRechts(RC1)"
  .UsedRange.Sort Key1:=.Cells(2, ErsteFreieSpalte), Order1:=xlAscending, Header:=xlYes
  .Columns(ErsteFreieSpalte).Delete
End With
End Sub


Datei im Anhang

Gruß Ralf


Angehängte Dateien
.xlsm   Sharky.xlsm (Größe: 15,01 KB / Downloads: 3)
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • sharky51
Top
#7
Hallo Ralf,

vielen Dank...hab das mal ausprobiert aber irgendwie funktioniert das bei mir nicht.
Wenn ich einen Breakpoint hierhin setze

  .Columns(ErsteFreieSpalte).Sort Key1:=.Cells(2, ErsteFreieSpalte), Order1:=xlAscending, Header:=xlYes

und dann einen Schritt weiter gehe sehe ich in der "Übtemp"-Spalte das sortierte Ergebnis des abgeschnittenen Teilstrings.
Abschließend erfolgt aber keine Änderung in der ersten Spalte, d.h. es wird nichts zurück geschrieben.
Top
#8
Hi!
Ich hatte den Code sowie die eingestellte Datei nochmal geändert (um 16:11).
Ich hatte versehentlich eine falsche (frühere) Version hochgeladen.
Einzige Änderung:
.UsedRange.Sort
statt
.Columns(ErsteFreieSpalte).Sort

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • sharky51
Top
#9
Hi Ralf,

ja super! Klappt jetzt toll. Danke!

Vielen Dank für Deine Unterstützung!
Top
#10
Alternative:

Code:
Sub M_snb()
  sn = Tabelle1.Cells(1).CurrentRegion
  
  With CreateObject("System.Collections.ArrayList")
    For j = 2 To UBound(sn)
      .Add "_" & Split(sn(j, 1), "\")(UBound(Split(sn(j, 1), "\"))) & sn(j, 1)
    Next
    .Sort
    Tabelle1.Cells(1).CurrentRegion.Columns(1).Offset(1).Resize(UBound(sn) - 1) = Application.Transpose(.toarray)
  End With
  
  Tabelle1.Columns(1).Replace "_*D:", "D:"
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • sharky51
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 2 Gast/Gäste