title image


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



ich glaube dir,dass mein Anliegen etwas unübersichtlich erscheint.

Ich versuche es etwas exakter zu erläutern.



2. Ich habe folgende Tabelle1 (Quelle):

P10000 Name Hurtig

P20000 Vorname, erster Vorname Harry

P30000 Geburtsdatum 19.11.1975

P31000 Geburtsort Kleinkleckerdorf

P40000 Postleitzahl, Wohnort 15526

P41000 Ort, Wohnort Bad Saarow

P42000 Straße (Wohnort) Wilmersdorfer Str. 15

P10000 Name Schnurri

P20000 Vorname, erster Vorname Harald

P31000 Geburtsort Oberdorf

P40000 Postleitzahl, Wohnort 12345

P41000 Ort, Wohnort Oberdorf

P42000 Straße (Wohnort) Kleine Str. 15

P10000 Name Schlumpf

P20000 Vorname, erster Vorname Papa

P30000 Geburtsdatum 10.10.1965

P31000 Geburtsort Adorf

P32000 Anderer Wohnort Posenuckel

P40000 Postleitzahl, Wohnort 23456

P41000 Ort, Wohnort Bdorf

P42000 Straße (Wohnort) Lange Str. 15



usw.



In Tabelle2 habe ich den Spalten ausgewählte Codenzuordnungen eingerichtet

Name Vorname Wohnort





In Tabelle2 (Ziel) habe ich den Spalten ausgewählte Codenzuordnungen eingerichtet

Name Vorname Wohnort



Der Wert aus Tabelle1 von P10000, P20000 und P30000 aus Spalte 3 sollen in Tabelle2 in die entsprechende Spalte Name (P10000), Vorname (P20000), Wohnort (P30000) als ein Datensatz (eine Zeile) übertragen werden.

Ein neuer Datensatz (P10000, P20000 u. P30000) soll angelegt werden, wenn in Tabelle1 Spalte 1 P10000 auftaucht.



Das Ganze soll also sich wiederholen, wenn der Wert P10000 auftaucht. Wenn eine leere Zelle in Spalte 1 ist, soll das Makro beendet werden.



Also der Pseudo-Code wäre so:

Suche in Worksheets(1) .Columns(1) "P10000"

wenn gefunden dann

übertrage den Wert aus Workshetets(1).Cells(0,3) in erste freie Zeile Spalte1 Worksheets(2)

dann suche P20000

wenn P20000 gefunden dann

übertrage Wert aus Workshetets(1).Cells(0,3) in gleiche Zeile Spalte2

dann suche P30000

wenn P30000 gefunden

dann übertrage Wert aus Workshetets(1).Cells(0,3)



und das ganze wieder von vorne, bis alle Daten durchsucht sind (Wert in Worksheets(1).Columns(1)="")



Geht das so

ich folgendes Makro (läuft ziemlich gut, aber es schreibt in Spalte den Wert IMMER an die erste freie Stele (End(xlUp) und nicht in die entsprechende dazugehörige Zeile)

Schau es Dir doch bitte mal an.



Option Explicit

Sub übertragen()

Dim SB As String, C As Range, A As Byte

Dim WS1 As Worksheet, WS2 As Worksheet

Dim FAdd As String



Set WS1 = Sheets(1)

Set WS2 = Sheets("Ziel")



If WS2.[a2] "" Then Exit Sub

For A = 1 To 6

Select Case A

Case 1: SB = "P10000"

Case 2: SB = "P20000"

Case 3: SB = "P30000"

Case 4: SB = "P40000"

Case 5: SB = "P41000"

Case 6: SB = "P42000"

End Select

With WS1.Columns(1)

Set C = .Find(SB, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows)

If Not C Is Nothing Then

FAdd = C.Address

Do

On Error GoTo ENDE

WS2.Cells(65536, A).End(xlUp).Offset(1, 0) = C.Offset(0, 3)

Set C = .FindNext(C)

Loop While Not C Is Nothing And C.Address FAdd

End If

End With

Next

ENDE:

Set WS1 = Nothing

Set WS2 = Nothing

End Sub





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: