Makro um Inhalte neu anzuordnen

Moderator: ModerationP

Makro um Inhalte neu anzuordnen

Beitragvon jürgen88 » 24. Okt 2021, 16:54

Hallo!
Ich benötige ein Makro, das Inhalte aus Zeilen neu anordnet und dann in einem zweiten Tabellenblatt ausgibt.

Im zweiten Tabellenblatt soll dann die Ursprungsversion + alle Varianten ausgegeben werden.

Konkretes Beispiel:

INPUT Tabelle1
A B C
1 AAA BBB CCC
2 DDD EEE

OUTPUT Tabelle2
A B C
1 AAA BBB CCC
2 CCC AAA BBB
3 BBB CCC AAA
4 DDD EEE
5 EEE DDD

Der Inhalt aus jeder Zelle je Zeile soll also einmal am Anfang stehen, die Reihenfolge der folgenden Inhalte ist egal.

Kann mir da jemand weiterhelfen? Wäre super!
Danke im Voraus!
jürgen88
 

Re: Makro um Inhalte neu anzuordnen

Beitragvon AlterDresdner » 24. Okt 2021, 20:06

Hallo Jürgen,
falls "die Reihenfolge der folgenden Inhalte ist egal" wirklich so ist, wäre der folgende Code eine Möglichkeit:
Code: Alles auswählen
Option Explicit

Sub Varianten()
Const Spalte1 = 1 'ggfls. anpassen
Const Zeile1 = 2
Dim zeile As Long, spalte As Long, i As Long, j As Long
Dim Ziel As Object, Quelle As Object, zielzeile As Long, Inhalt() As String
  Set Quelle = ActiveSheet
  Set Ziel = Sheets.Add(after:=Sheets(Sheets.Count))
  With Quelle
    zeile = Zeile1
    zielzeile = 1
    Do
      ReDim Inhalt(1 To 1)
      spalte = Spalte1
      Do 'Auslesen der Quellenzeile
        i = spalte - Spalte1 + 1
        If i > UBound(Inhalt) Then ReDim Preserve Inhalt(1 To i)
        Inhalt(i) = .Cells(zeile, spalte).Text
        spalte = spalte + 1
      Loop Until IsEmpty(.Cells(zeile, spalte))
      For i = 1 To UBound(Inhalt) 'Schreiben der Zielzeilen
        Ziel.Cells(zielzeile, 1) = Inhalt(i)
        spalte = 2
        For j = 1 To UBound(Inhalt)
          If j <> i Then
            Ziel.Cells(zielzeile, spalte) = Inhalt(j)
            spalte = spalte + 1
          End If
        Next j
        zielzeile = zielzeile + 1
      Next i
      zeile = zeile + 1
    Loop Until IsEmpty(.Cells(zeile, Spalte1))
  End With
End Sub
Gruß der AlteDresdner
(Win 10 32bit, Off2010)
AlterDresdner
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 125
Registriert: 24. Okt 2015, 15:57

Re: Makro um Inhalte neu anzuordnen

Beitragvon Gast » 24. Okt 2021, 20:58

@DerAlteDresdner
Hey danke! Aber das Makro schreibt nur die zweite Zeile um, nicht aber die erste. Und es sind auch weitaus mehr Zeilen als nur zwei in der Original-Datei. Es müsste also beliebig viele Zeilen und Spalten neu anordnen können. Wobei es vermutlich nicht mehr als drei Spalten sein werden, aber durchaus 100 Zeilen.
Gast
 

Re: Makro um Inhalte neu anzuordnen

Beitragvon AlterDresdner » 25. Okt 2021, 11:05

Hallo Jürgen,
die beiden Konstanten
Const Spalte1 = 1 'ggfls. anpassen
Const Zeile1 = 2
regeln: Spalte1 ist die erste Spalte, aus der gelesen wird, Zeile1 ist die erste Zeile, aus der gelesen wird.
Wenn das Zeile 1 ist, dann musst Du die Konstante in 1 ändern.
Das Lesen endet, wenn in Spalte1 eine leere Zelle auftritt.
Gruß der AlteDresdner
(Win 10 32bit, Off2010)
AlterDresdner
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 125
Registriert: 24. Okt 2015, 15:57

Re: Makro um Inhalte neu anzuordnen

Beitragvon HKindler » 25. Okt 2021, 14:28

Hi,

mein Vorschlag:
Code: Alles auswählen
Sub mach()
Dim wsh As Worksheet
Dim Zeile As Range
Dim Wert As Range
Dim aktZeile As Long
Set wsh = ActiveSheet
With ActiveWorkbook.Worksheets.Add(after:=wsh)
    For Each Zeile In wsh.UsedRange.Rows
        For Each Wert In Zeile.Resize(, WorksheetFunction.CountA(Zeile)).Cells
            aktZeile = aktZeile + 1
            Zeile.Copy .Cells(aktZeile, 1)
            .Cells(aktZeile, 1) = Wert
            .Cells(aktZeile, Wert.Column) = Zeile.Cells(1)
        Next Wert
    Next Zeile
End With
End Sub
Gruß,
Helmut

----------------------------
Windows 10 Enterprise (64 Bit) / Office 365 ProPlus (32 Bit)
Benutzeravatar
HKindler
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6440
Registriert: 04. Jul 2013, 09:02
Wohnort: Schwarzwald

Re: Makro um Inhalte neu anzuordnen

Beitragvon Gast » 25. Okt 2021, 16:34

SUPER! Danke euch beiden!
Variante von Helmut funktioniert perfekt.
Gast
 


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: < Peter >, Bing [Bot], HKindler, Klaus-Dieter, Kuwe, SunnuS und 23 Gäste