title image


Smiley Re: (E97)VBA-Problem: Daten von vertikal in horizontal
Hallo Hardy,



ich glaube, ich habe es verstanden. Ich habe mal eine Lösung entwickelt, die anscheinend ganz gut funktioniert.

Voraussetzung ist, daß Du die Spaltenköpfe in der Zieltabelle nach dem Muster "Pxxxxx Spaltenname" gestaltest.

Schau es Dir mal an.



Ciao

Alonso





Option Explicit



Sub MeinÜbertragen()

Dim Spalte As String, Datensatz As String, Vergleich As String

Dim Alpha As Long, Beta As Long, Gamma As Long, Laenge As Long, MaxGamma As Long

Dim NSpalte As Double, OldNSpalte As Double

Dim WasGefunden As Boolean, Abb As Boolean

'Grundvoraussetzung für die Zieltabelle ist, daß die Spaltenköpfe

'im Format "Pxxxxx Spaltenbezeichnung" stehen!!!!!!!!!!!

'Diese Daten werden für die weitere Auswertung benötigt.

'1. Um die richtige Zeile zu finden,

'2. Um den Datensatz korrekt zurechtzustutzen, damit keine überflüssigen

'Daten übernommen werden.

'

'Dieses Vorgehen erlaubt, nicht erwünschte Spalten einfach wegzulassen, bzw.

'im nachhinein gewünschte Spalten einfach hinzuzufügen.



Alpha = 1 'Zeilennummer in der Quelltabelle

Beta = 0 'Zeilennummer in der Zieltabelle!

OldNSpalte = 0

Gamma = 0 'Spaltennummer in der Zieltabelle!



'Ermitteln der maximalen Spaltennummer in der Zieltabelle

Do Until Worksheets("ziel").Cells(1, Gamma + 1) = ""

Gamma = Gamma + 1

Loop

MaxGamma = Gamma



'Ermitteln der ersten Leerzeile in der Zieltabelle

Do

Beta = Beta + 1

Abb = True

For Gamma = 1 To MaxGamma

If Not Worksheets("ziel").Cells(Beta, Gamma) = "" Then Abb = False

If Abb = False Then Gamma = MaxGamma

Next

Loop Until Abb



'Verarbeitung der Datensätze aus der Quelltabelle

Do

Datensatz = Worksheets("tabelle1").Cells(Alpha, 1)

If Not Datensatz = "" Then 'Wird nur ausgeführt, wenn ein Datensatz vorhanden ist.

Spalte = Left$(Datensatz, 6)

If IsNumeric(Right$(Spalte, 5)) Then NSpalte = Val(Right$(Spalte, 5))



'Wenn ein kleineres "Pxxxxx" angewählt wird, dann wird in der Zieltabelle

'ein Zeilenvorschub durchgeführt.

If NSpalte < OldNSpalte Then Beta = Beta + 1

Gamma = 0 'Spaltennummer in der Zieltabelle

Do

'Diese Loop-Schleife ermittelt die korrekte Spaltennummer in der Zieltabelle

Gamma = Gamma + 1

Vergleich = Left$(Worksheets("ziel").Cells(1, Gamma), 6)

Laenge = Len(Worksheets("ziel").Cells(1, Gamma))

If Vergleich = "" Then WasGefunden = False Else WasGefunden = True

Loop Until Vergleich = Spalte Or Gamma > MaxGamma



'Wenn eine Nummer ermittelt wurde, dann wird der Datensatz eingetragen.

If WasGefunden Then

Worksheets("ziel").Cells(Beta, Gamma) = Right$(Datensatz, Len(Datensatz) - Laenge)

End If



OldNSpalte = NSpalte

Alpha = Alpha + 1

End If

Loop Until Datensatz = ""



MsgBox "Fertig!"

End Sub
deutschsprachige Wikibooks

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: