Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1264to1268
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1264to1268
1264to1268
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Spalten anordnen nach Vorgabe

Spalten anordnen nach Vorgabe
Thore
Hallo Liebe VBA Freunde,
Also ich bekomme jeden Tag von x Mitarbeitern 5 verschiedene Tabellen die alle zwar die gleichen Spalten
beinhalten aber in unterschiedlicher Reihenfolge.
Könnt Ihr mir eine Makro basteln das folgendes tut:
Vorhandene Spalten anordnen wie folgt:
Suchbegriff | Debitor | Anlage A | Anlage B | Summe | Datum | Diff. AB | x Über | usw.
Wäre auch gut wenn es die Möglichkeit beinhaltet die zu verschiebenen Spalten um x Spalten zu erweitern in dem man vielleicht vorhandenen Strings kopiert und den Spaltennamen anpasst.
Hoffe das ist so verständlich.
Danke schon einmal
Gruß
Thore

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Spalten anordnen nach Vorgabe
21.05.2012 20:11:30
Rolf
Hallo Thore,
wozu so ein Aufwand?
Ist es dir nicht möglich, den Mitarbeitern zu sagen, sie möchten bitte alle ein einheitliches
Format (das du vorgibst) verwenden?
Gruß, Rolf
AW:Bitte um eure Hilfe bei Makro Erstellung
21.05.2012 21:36:29
Thore
Rolf / Thore
Das war Hypothetisch gemeint um die Aufgabe zu erläutern.
Richtig ist aber auch dass dieses Verfahren gängige Praxis werden wird
da in einem Testverfahren Spalten erstellt werden durch "Wenn;Dann usw"
So ergibt sich nachher ein Kuddelmuddel durch die Abhängigkeit der Reihenfolge der jeweiligen Eingaben.
Das ist aber noch weg!!!
Ich frage nun mal anders:
Ist es überhaupt möglich Spalten nach Schema F über ein Makro in einer Vorgegebenen Reihenfolge in Abhängigkeit der Spaltenüberschriften (A1 bis AZ1 - sind immer gleich nur nicht sortiert) von links nach rechts anzuordnen?
Ich habe dieses Makro gefunden. Ist aber kaum zu gebrauchen da ich hier alles manuell eingeben müsste:
Sub Spalte_verschieben()
Dim QS, ZS As String
Q = InputBox("Welche Spalte soll verschoben werden?")
Z = InputBox("Vor welcher Spalte soll eingefügt werden?")
QS = Q & ":" & Q
ZS = Z & ":" & Z
Columns(QS).Select
Selection.Cut
Columns(ZS).Select
Selection.Insert Shift:=xlToRight
End Sub
Danke schon einmal für die Hilfe!!!
Gruß
Thore
Anzeige
AW: Spalten anordnen nach Vorgabe
21.05.2012 22:37:45
Josef

Hallo Thore,
ein (ausbaubares) Beispiel.
Sub rearangeColumns()
  Dim vntColumns As Variant, vntAranged() As Variant
  Dim vntRet As Variant
  Dim lngindex As Long
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  vntColumns = Array("Datum", "Name", "Wert2", "Wert1") 'Spalten in der gewünschten Reihenfolge
  
  Redim vntAranged(1 To UBound(vntColumns) + 1)
  
  For lngindex = 0 To UBound(vntColumns)
    vntRet = Application.Match(vntColumns(lngindex), Rows(1), 0)
    If IsNumeric(vntRet) Then
      vntAranged(lngindex + 1) = Columns(vntRet)
    End If
  Next
  
  For lngindex = 1 To UBound(vntAranged, 1)
    Cells(1, lngindex).Resize(Rows.Count, 1) = vntAranged(lngindex)
  Next
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'rearangeColumns'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub



« Gruß Sepp »

Anzeige
AW: rearangeColumns - WAHNSINN
22.05.2012 00:48:15
Thore
Josef / Thore
Nicht einmal im Ansatz hätte ich so etwas schreiben können.
Ich habe gerade fast alle "menschlichen" Variablen durchgespielt, mit aktuell 26 Spalten, und bestätige hiermit (mit Beschränkung auf meine Tabellen) dass Dein Makro Lupenrein ist.
Ich glaube damit hast du ein derweil "einzigartiges" Makro geschrieben.
Vielen Lieben Dank.
PS: Vielleicht hast Du noch Ideen zur Performance des Makros ?
Gruß
Thore
AW: rearangeColumns - WAHNSINN
22.05.2012 18:00:56
Josef

Hallo Thore,
ein wenig ausgebaut. Es werden nicht mehr die ganzen Spalten verschoben, sondern nur mehr die gefüllten Zellen. Außerdem werden die Formate (von der ersten Datenzeile) übernommen und die Spaltenbreiten angepasst.
Sub rearangeColumns()
  Dim vntColumns As Variant, vntAranged() As Variant, vntFormat() As Variant
  Dim vntRet As Variant
  Dim lngindex As Long, lngCalc As Long, lngLast As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  vntColumns = Array("Datum", "Name", "Wert2", "Wert1") 'Spalten in der gewünschten Reihenfolge
  
  Redim vntAranged(1 To UBound(vntColumns) + 1)
  Redim vntFormat(1 To UBound(vntColumns) + 1)
  
  For lngindex = 0 To UBound(vntColumns)
    vntRet = Application.Match(vntColumns(lngindex), Rows(1), 0)
    If IsNumeric(vntRet) Then
      lngLast = Application.Max(2, Cells(Rows.Count, vntRet).End(xlUp).Row)
      vntAranged(lngindex + 1) = Cells(1, vntRet).Resize(lngLast, 1)
      vntFormat(lngindex + 1) = Cells(2, vntRet).NumberFormat
    End If
  Next
  
  For lngindex = 1 To UBound(vntAranged, 1)
    Columns(lngindex) = ""
    Columns(lngindex).NumberFormat = vntFormat(lngindex)
    Cells(1, lngindex).Resize(UBound(vntAranged(lngindex)), 1) = vntAranged(lngindex)
    Columns(lngindex).AutoFit
  Next
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'rearangeColumns'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub



« Gruß Sepp »

Anzeige
Bei "rearange" fehlt immer noch 1 r! ;-) Gruß owT
22.05.2012 18:51:33
Luc:-?
:-?
AW: schnell, schneller - TOP
22.05.2012 19:58:48
Thore
Moin Josef,
jau, das ist es!!!
Für alle anderen auch mal veranschaulicht, siehe Dateipfad, wie gut der Code funktioniert.
https://www.herber.de/bbs/user/80259.zip
Datei ist über 300kb deswegen gepackt!!!
Versucht auch mal in Kombination mit Doppelte Spalten löschen um Laufzeitfehler zu vermeiden falls doppelte vorhanden sein sollten/könnten.
Sub rearangeColumns0()
Sheets("Tabelle1").Select
CC = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte
For i = CC To 2 Step -1
If Cells(1, i).Value = Cells(1, i - 1).Value Then
Columns(i).Delete Shift:=xlToLeft
End If
Next
...und dann wie gehabt weiter
Danke und Gruß
Thore
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige