title image


Smiley VBA-Lösung von Alonso - Daten von vertikal in horizontal (97)
Meinen besten Dank an Alonso, der sich ganz große Mühe gegeben hat eine Lösung für mich zu finden.

Ich möchte sie natürlich anderen nicht vorenthalten.

Problem:

Habe eine Tabelle, wo die Daten untereinander in 3 Spalten aufgeführt werden. Spalte1 = Codenummern, Spalte2 = Bezeichnung, Spalte 3 = Daten.

Nun möchte bestimmte ausgewählte Daten in eine 2 Tabelle horizontal übertragen. Aber nicht immer sind diese Daten vorhanden.

Tabelle:

P100000 Name Hurtig

P200000 Vorname Harry

P210000 Spitzname Egon

P220000 Künstlername Flurry

P300000 Wohnort Kleinkleckersdorf

P310000 Schuhgröße 50

P320000 Aktuelles Datum 11.11.2002

P400000 Gage 12000

Ende

P100000 Name Schlumpf

P110000 Geburtsname Schlumpferine

P200000 Vorname Berta

P220000 Künstlername Blauline

P300000 Wohnort Schlumpfhausen

Ende

usw.



Hier Alonsos Lösung:

Bedingung ist, dass die ausgewählten Codenummern als Spaltennamen eingerichtet sind.



Sub MeinÜbertragen()

Dim Spalte As String, Datensatz As String, Vergleich As String, Datum As String, Bezeichnung 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 "Pxxxxxx 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("Quelle").Cells(Alpha, 1)

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

Spalte = Datensatz

Datum = Worksheets("Quelle").Cells(Alpha, 3)

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



'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 = 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) = Datum

End If



OldNSpalte = NSpalte

Alpha = Alpha + 1

End If

Loop Until Datensatz = ""



MsgBox "Fertig!"

End Sub

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: