Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Spalten Dynamisch untereinander einfügen mit VBA
#1
Hallo zusammen,

kurz zur Info, ich bin ein Anfänger in VBA und beherrsche die meisten Sachen nur durch das Aufzeichnen von Makros. Dynamisches VBA programmieren ist bei mir noch etwas entfernt.

Ich habe es geschafft einige Daten aus einer Umfangreichen Tabelle in einen neuen Reiter nebeneinander zu fügen.
Ich muss wohl im nächsten Schritt eine gewisse Dynamic im VBA Code verwenden, um alle Daten untereinander in Spalte A zu bekommen.

Anbei könnt Ihr den Datensatz (Alle Namen wurden durch Zahlen ersetzt) finden um den es geht. Im Reiter "SOLL" könnt Ihr das Format sehen in das ich die Daten benötige.

Wenn die Daten alle untereinander stehen, sollte ich den Rest selber schaffen.


Vielen Dank schon mal für eure Hilfe!

Beste Grüße Sleepy


Angehängte Dateien
.xlsx   DatenMitVBAUntereinadner.xlsx (Größe: 13,59 KB / Downloads: 5)
Antworten Top
#2
Mahlzeit Sammy,

ein Vorschlag:

Code:
Const m_sZiel As String = "IST"

Sub TransposeYtoX()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rng As Range, rngUsedRange As Range
    Dim lngLastRow As Long, lngLastCol As Long, i As Long
    Dim arr() As Variant
    '
    On Error GoTo err
    '
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets(m_sZiel)
    Set rngUsedRange = wks.UsedRange
    '
    With wks
        lngLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To lngLastCol Step 1
            Set rng = rngUsedRange.Columns(i).Cells
            Let arr = rng
            Let lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Let .Cells(lngLastRow, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Next i
    End With
    '
err:
If err.Number <> 0 Then
    MsgBox err.Number & vbCrLf & err.Description
End If
'
Erase arr
Set rngUsedRange = Nothing: Set rng = Nothing
Set wks = Nothing: Set wkb = Nothing
End Sub


Angehängte Dateien
.xlsm   DatenMitVBAUntereinadner.xlsm (Größe: 20,79 KB / Downloads: 2)
gruß
Marco
[-] Folgende(r) 2 Nutzer sagen Danke an Mase für diesen Beitrag:
  • SemmyW, Andy_S_PB
Antworten Top
#3
(24.09.2019, 11:57)Mase schrieb: Mahlzeit Sammy,

ein Vorschlag:

Code:
Const m_sZiel As String = "IST"

Sub TransposeYtoX()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rng As Range, rngUsedRange As Range
    Dim lngLastRow As Long, lngLastCol As Long, i As Long
    Dim arr() As Variant
    '
    On Error GoTo err
    '
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets(m_sZiel)
    Set rngUsedRange = wks.UsedRange
    '
    With wks
        lngLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 2 To lngLastCol Step 1
            Set rng = rngUsedRange.Columns(i).Cells
            Let arr = rng
            Let lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Let .Cells(lngLastRow, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Next i
    End With
    '
err:
If err.Number <> 0 Then
    MsgBox err.Number & vbCrLf & err.Description
End If
'
Erase arr
Set rngUsedRange = Nothing: Set rng = Nothing
Set wks = Nothing: Set wkb = Nothing
End Sub

Vielen Dank!
Das hat ja gleich super geklappt.

Bis ich das kann dauert es wohl noch ein wenig.
Magst du mir die wichtigsten Zeilen des Makros kurz erklären?


Speziell was machen die 3 Codes?
Const m_sZiel As String = "IST"
____
.
.
.
____
Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function



Auf jeden Fall schon mal Danke!
Hat mich weiter gebracht. Jetzt muss ich das nur noch in meinen bestehenden VBA Code einfügen. :15:
Antworten Top
#4
Hi,

freut mich, dass es Dich weiterbringt.

Code:
Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function
Hier wollte ich das Ermitteln der letzten Spalte bzw letzten Zeile für Dich in eine Funktion auslagern, da Du das zukünftig (wahrscheinlich) immer wieder brauchst.
Hatte mich im Verlauf aber dagegen entschieden und nicht wieder entfernt. Kannste ignorieren.

Code:
Const m_sZiel As String = "IST"


Hier wird der Arbeitsblattname als Konstante des Datentyps Strings definiert.
Natürlich ginge es auch mit einer Variablen des Datentyps String.

Die erstgenannte Variante läuft schneller durch als die Zweitgenannte.
gruß
Marco
[-] Folgende(r) 2 Nutzer sagen Danke an Mase für diesen Beitrag:
  • SemmyW, Andy_S_PB
Antworten Top
#5
(24.09.2019, 21:04)Mase schrieb: Hi,

freut mich, dass es Dich weiterbringt.

Code:
Function getLastRow(wks As Worksheet) As Long

End Function
____
Function getLastCol(wks As Worksheet) As Long

End Function
Hier wollte ich das Ermitteln der letzten Spalte bzw letzten Zeile für Dich in eine Funktion auslagern, da Du das zukünftig (wahrscheinlich) immer wieder brauchst.
Hatte mich im Verlauf aber dagegen entschieden und nicht wieder entfernt. Kannste ignorieren.

Code:
Const m_sZiel As String = "IST"


Hier wird der Arbeitsblattname als Konstante des Datentyps Strings definiert.
Natürlich ginge es auch mit einer Variablen des Datentyps String.

Die erstgenannte Variante läuft schneller durch als die Zweitgenannte.

Danke sehr!
Antworten Top


Gehe zu:


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