Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1344to1348
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

Tabellenwerte kopieren und transponieren

Tabellenwerte kopieren und transponieren
27.01.2014 14:43:27
klausk
Hallo zusammen,
In dem sheet „test_csv1“ soll die Spalte A bis zum Ende bzw. bis zum ersten leeren Wert durchlaufen werden und bezogen auf den gleichen Wert z.B „B71-G20-ST-nur HP-Info“ die korrespondierenden Werte zur Projektbegründung, Projekthistorie, Alternativenprüfung, Raumordnung, Städtepotenzial, Weitere Projektwirkungen, Umweltfachliche Gegebenheiten, Weitere Hinweise zum Projekt aus der Spalte nächsten Spalte F transponiert in das sheet „Übersicht H-Projekte“ eintragen Der folgende Code-Schnipsel macht das nur bis für den 1. Wert (hier B71-G20-ST-nur HP-Info“.
Sub ProjektListeErzeugen()
Dim Zellwert As String 'Variable für Zellwert
Dim Ze As Double 'Zeilenzähler für die Loop-Schleife
Dim StartZelle As String
Dim ZielZe As Double 'Ausgabezeile für das Sheet H-Projekte
Dim ZielSp As Integer 'Ausgabespalte für das Sheet H-Projekte
Ze = 2
ZielSp = 3
ZielZe = 2
Worksheets("test_csv1").Activate
StartZelle = Range("A2").Formula
With ActiveSheet
Do Until IsEmpty(Cells(Ze, 1))
If Cells(Ze, 1).Formula = StartZelle Then
If Cells(Ze, 5).Formula  "STR" Then
Zellwert = Cells(Ze, 1).Offset(1, 5).Formula
Sheets(2).Cells(ZielZe, ZielSp).Formula = Zellwert
ZielSp = ZielSp + 1
'MsgBox Zellwert
ElseIf Cells(Ze, 5).Formula = "STR" Then
'                    Zellwert = Cells(Ze + 1, 1).Offset(1, 5).Formula
'                    Sheets(2).Cells(ZielZe, ZielSp).Formula = Zellwert
'                    ZielSp = ZielSp + 1
End If
Else
ZielZe = ZielZe + 1
StartZelle = Cells(Ze, 1).Formula
End If
Ze = Ze + 1
Loop
End With
End Sub

https://www.herber.de/bbs/user/88991.xlsx
Hat da jemand eine Idee? Danke Klaus

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

Betreff
Datum
Anwender
Anzeige
AW: Tabellenwerte kopieren und transponieren
27.01.2014 15:55:21
fcs
Hallo Klaus,
hier dein Makro angepasst und eine Variante mit 2 For-Next-Schleifen
Gruß
Franz
Sub ProjektListeErzeugen_neu()
Dim Ze As Double 'Zeilenzähler für die Loop-Schleife
Dim ZielZe As Double 'Ausgabezeile für das Sheet H-Projekte
Dim ZielSp As Integer 'Ausgabespalte für das Sheet H-Projekte
Dim wksZiel As Worksheet
Dim wks As Worksheet
Dim intWert As Integer
Set wksZiel = Worksheets("Übersicht H-Projekte")
Set wks = Worksheets("test_csv1")
ZielZe = 2
With wks
For Ze = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row Step 9
wksZiel.Cells(ZielZe, 1).Value = .Cells(Ze, 1).Value
wksZiel.Cells(ZielZe, 2).Value = .Cells(Ze, 3).Value
For intWert = 1 To 8
ZielSp = 2 + intWert
wksZiel.Cells(ZielZe, ZielSp).Value = .Cells(Ze + intWert, 6).Value
Next
ZielZe = ZielZe + 1
Next
End With
End Sub
Sub ProjektListeErzeugen()
Dim Zellwert As String 'Variable für Zellwert
Dim Ze As Double 'Zeilenzähler für die Loop-Schleife
Dim StartZelle As String
Dim ZielZe As Double 'Ausgabezeile für das Sheet H-Projekte
Dim ZielSp As Integer 'Ausgabespalte für das Sheet H-Projekte
Dim wksZiel As Worksheet
Ze = 2
Set wksZiel = Worksheets("Übersicht H-Projekte")
ZielZe = 1
Worksheets("test_csv1").Activate
StartZelle = ""
With ActiveSheet
Do Until IsEmpty(.Cells(Ze, 1))
If .Cells(Ze, 1).Text  StartZelle Then
ZielZe = ZielZe + 1
StartZelle = .Cells(Ze, 1).Text
wksZiel.Cells(ZielZe, 1) = StartZelle
wksZiel.Cells(ZielZe, 2) = .Cells(Ze, 3).Text
ZielSp = 3
Else
Zellwert = .Cells(Ze, 6).Text
wksZiel.Cells(ZielZe, ZielSp).Formula = Zellwert
ZielSp = ZielSp + 1
'MsgBox Zellwert
End If
Ze = Ze + 1
Loop
End With
End Sub

Anzeige
AW: Tabellenwerte kopieren und transponieren
29.01.2014 16:36:29
klaus
hallo franz
SIEHT SEHT GUT AUS! DIR TAUSEND DANK
klaus

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige