Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1564to1568
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
Inhaltsverzeichnis

vba Transponieren

vba Transponieren
24.06.2017 18:03:07
Adem
Hallo zusammen,
ich hoffe ich kann mein folgendes Problem erklären.
Userbild
wie im Beispiel oben möchte ich, wenn mehrere "ChNr:" in der Spalte sich befinden transponieren. Das ganze soll mit VBA Code stattfinden. Das Bild zeigt ihnen ein Beispiel aus meiner Liste mit Lösung wie ich es gerne haben möchte, mir fehlt leider nur der VBA Code dazu.
Da ich die ganze Tabelle nicht draufbekommen hab, möchte ich nur noch ergänzen das ich noch ne Spalte Menge hab. Bei dem Beispiel ohne transponieren steht bei der Menge bei mir 10 und in der Lösung unten ist es untereinander 1,2,1,3,1,1,1
schöne Grüße
Cakir

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: vba Transponieren
24.06.2017 21:03:04
Zwenn
Hallo Cakir,
Du hast Dein Problem zwar gut beschrieben, aber niemand wird sich Deine Daten selbst zusammenbauen, um zu testen, was er programmiert hat. Bitte lade eine Beispielmappe mit den Daten hoch, damit man die direkt verwenden kann.
Viele Grüße,
Zwenn
AW: vba Transponieren
24.06.2017 22:13:59
Matthias
Moin! Probiere es mal so. Hat im Test bei mir geklappt. Vllt. hilft es dir ja auch schon. Musste hier Zeilenumbrüche einfügen die mal wieder rausnehmen. VG

Option Explicit
Sub transponieren()
Dim ende As Long
Dim zeile As Long
Dim suchwert As String
Dim anzahl As Long
Dim lauf As Long
Dim werte
Dim bereich
Application.ScreenUpdating = False
ende = ActiveSheet.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row
suchwert = "ChNr:"
For zeile = ende To 2 Step -1
werte = Split(ActiveSheet.Cells(zeile, 3), suchwert, , vbTextCompare)
anzahl = UBound(werte)
If anzahl > 1 Then
ActiveSheet.Rows(zeile + 1 & ":" & zeile + anzahl - 1).Insert Shift:=xlDown
bereich = ActiveSheet.Range(ActiveSheet.Cells(zeile, 1), _
ActiveSheet.Cells(zeile + anzahl - 1, 4))
For lauf = 1 To anzahl
bereich(lauf, 1) = bereich(1, 1)
bereich(lauf, 2) = bereich(1, 2)
bereich(lauf, 3) = suchwert & werte(lauf)
bereich(lauf, 4) = CLng(Split(Split(bereich(lauf, 3), "Menge:")(1), ",")(0))
Next lauf
ActiveSheet.Range(ActiveSheet.Cells(zeile, 1), ActiveSheet.Cells(zeile + anzahl - 1, 4)) _
_
= bereich
End If
Next zeile
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige