Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
960to964
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
960to964
960to964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabelle umbauen

Tabelle umbauen
15.03.2008 09:23:00
thomas
Hallo Zusammen,
habe folgendes Problem.
in A1 steht die interne Nummer in A2 .... stehen weitere interne Nummern und in den Spalten BC... stehen
die Lieferanten
B1 Lieferant 1 C1 Bezeichnung Lieferant 1
D1 Lieferant 2 E2 Bezeichnung Lieferant 2
usw.
ich benötige eine Liste die so ist.
A immer die interne Nummer und B immer Lieferant C immer Bezeichnung Lieferant
Wenn es mehrere Lieferanten gibt werden die internen Nummern in A mehrmals enthalten sein.
xyz Maier 1234
xyz Mueller 2345
Wie kann ich eine solche Liste einfach erzeugen habe ca. 5000 interne Nummern und durchschnittlich
4 Lieferanen.
Gruß Thomas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle umbauen
15.03.2008 10:17:05
Erich
Hallo Thomas,
probier mal

Option Explicit
Sub Umorg()
Dim zQ As Long, zZ As Long, ss As Long
With ActiveSheet
Worksheets.Add
For zQ = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
zZ = zZ + 1
Cells(zZ, 1).Resize(, 3) = .Cells(zQ, 1).Resize(, 3).Value
For ss = 4 To .Cells(zQ, .Columns.Count).End(xlToLeft).Column Step 2
zZ = zZ + 1
Cells(zZ, 1) = Cells(zZ - 1, 1)
Cells(zZ, 2).Resize(, 2) = .Cells(zQ, ss).Resize(, 2).Value
Next ss
Next zQ
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Tabelle umbauen
15.03.2008 14:13:00
Thomas
Super Danke für die Hilfe
Gruß Thomas

Anzeige
AW: Tabelle umbauen
15.03.2008 11:17:14
fcs
Hallo thomas,
bei meiner etwas betagten Excelversion funktioniert der Resize-Befehl für RAnge-Objekte nicht, deshalb als Alternative:

Sub Datenumgruppieren()
Dim wsData As Worksheet, wsUmgr As Worksheet
Dim ZeileData As Long, ZeileUmgr As Long
Dim SpalteData As Long, SpalteUmgr As Long
Set wsData = ActiveSheet
Set wsUmgr = Worksheets.Add(After:=ActiveSheet)
Application.ScreenUpdating = False
ZeileUmgr = 2 '1. Zeile in der umgruppieret Daten eingetragen werden sollen
SpalteUmgr = 1 'Daten werden jeweils ab Spalte A eingetragen
With wsData
For ZeileData = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
For SpalteData = 2 To .Cells(ZeileData, .Columns.Count).End(xlToLeft).Column Step 2
wsUmgr.Cells(ZeileUmgr, SpalteUmgr).Value = .Cells(ZeileData, 1).Value
wsUmgr.Cells(ZeileUmgr, SpalteUmgr + 1).Value = .Cells(ZeileData, SpalteData).Value
wsUmgr.Cells(ZeileUmgr, SpalteUmgr + 2).Value = .Cells(ZeileData, SpalteData + 1).Value
ZeileUmgr = ZeileUmgr + 1
Next
Next
End With
wsUmgr.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Set wsData = Nothing: Set wsUmgr = Nothing
End Sub


Gruß
Franz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige