Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

doppelten eintrag erzeugen...





Frage

richtig gelesen, ich brauch doppelte einträge! naja ganz so einfach doch nicht....... ich habe eine tabelle (tabelle1) bei der in jeder zeile unterschiedliche materialien stehen. jedes nur einmal!!! in einer zweiten (tabelle2) von mir stehen alle meine materialien mit texten daneben. [aber nicht nur in einer spalte sondern in 8weiteren] mein makro soll in der ersten tabelle starten, den ersten wert mit der zweiten vergleichen und bei einer übereinstimmung den text daneben schreiben. funktioniert soweit gut. nur kann es sein das es eben in meiner zweiten tabelle mehrmals das selbe material gibt , mit unterschiedlichen texten. nun soll mir das makro das erkennen entsprechend neue zeilen einfügen und die entsprechenden texte kopieren. Tabelle1 A B C Tabelle2 A Text1 B Text1 B Text2 B Text3 C Text1 D Text1 Nach dem Code sollte es so aussehen Tabelle1 A Text1 B Text1 B Text2 B Text3 C Text1

Antwort 1 von StefanoInNot

meine bisgherige leistung:

Sub nr1()

x = Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y = Tabelle2.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Sheets("Tabelle1").Select
z = 1
s = 1
For z = 1 To x
Range(Cells(z, s), Cells(z, s)).Select
Buchstabe = ActiveCell.Value
Sheets("Tabelle2").Select
z2 = 1
s2 = 1

For z2 = 1 To y
Range(Cells(z2, 1), Cells(z2, 1)).Select
Buchstabe2 = ActiveCell.Value
If Buchstabe = Buchstabe2 Then

Sheets("Tabelle2").Select

Union(Range(Cells(z2, 2), Cells(z2, 2)), _
Range(Cells(z2, 3), Cells(z2, 3)), _
Range(Cells(z2, 4), Cells(z2, 4)), _
Range(Cells(z2, 5), Cells(z2, 5)), _
Range(Cells(z2, 6), Cells(z2, 6)), _
Range(Cells(z2, 7), Cells(z2, 7))).Select
'Range(Cells(z8, 8), Cells(z8, 8))).Select
'Range(Cells(z2, 9), Cells(z2, 9))).Select

Selection.Copy

Sheets("Tabelle1").Select

Union(Range(Cells(z, 2), Cells(z, 2)), _
Range(Cells(z, 3), Cells(z, 3)), _
Range(Cells(z, 4), Cells(z, 4)), _
Range(Cells(z, 5), Cells(z, 5)), _
Range(Cells(z, 6), Cells(z, 6)), _
Range(Cells(z, 7), Cells(z, 7))).Select
'Range(Cells(z, 8), Cells(z, 8))).Select
'Range(Cells(z, 9), Cells(z, 9))).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Tabelle2").Select
End If
Next z2
Sheets("Tabelle1").Select
Next z
End Sub


bei UNION(RANGE......
kann ich nur sechs zeilen aufnehmen, ist das normal??? gibts ne alternative

Antwort 2 von StefanoInNot

ich meine zellen....

Antwort 3 von coros

Hallo StefaninNot,

gestatte mir zum Anfang eine kleine Anmerkung. Ein Hallo am Anfang und ein Gruß am Ende würde Deinen Beitrag gleich viel netter aussehen lassen. Wenn Du zum Bäcker gehst sagst Du ja auch beim Reingehen "Guten Tag" und beim Gehen "Auf Wiedersehen". Denn die Leute, an die Du Deine Frage richtest, sitzen zwar am PC, sind aber dennoch Menschen.


Nun zu Deiner Frage: Leider ist es nicht ganz verständlich was Du mit

Zitat:
nur kann es sein das es eben in meiner zweiten tabelle mehrmals das selbe material gibt , mit unterschiedlichen texten. nun soll mir das makro das erkennen entsprechend neue zeilen einfügen und die entsprechenden texte kopieren.


meinst. Das müsstest Du mal etwas genauer beschreien.

Zu Deinem Code: Was sollen die Range-Anweisungen. Du markierst mit Diner Rangeanweisung immer die gleiche Zelle. Da reicht auch anstelle von z.B.

Range(Cells(z2, 2), Cells(z2, 2)) 

auch ganz einfach nur

Cells(z2, 2)


Außerdem musst Du die Zellen nicht mit Select markieren, sondern Du kannst sofort den Befehl .copy anfügen. Bei Dir würde das z.B. so aussehen

Union(Cells(z2, 2), Cells(z2, 3), _
        Cells(z2, 4), Cells(z2, 4), _
        Cells(z2, 5), Cells(z2, 6), _
        Cells(z2, 7), Cells(z2, 8)).Copy



MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 4 von StefanoInNot

Ein herzliches Hallo an Alle,
und besonders an dich Oliver!

Entschuldige bitte mein rüpelhaftes Benehmen. :-)

Habe das RANGE weggelassen so wie du es beschrieben hast, hat einwandfrei funktioniert, DANKE!

Es handelt sich um ein Makro für eine Wartungsliste.
Stell dir vor du hast in deinem ersten Tabellenblatt in der ersten Spalte Buchstaben stehen:

bsp.:

S
T
U
V

in deinem zweiten Tabellenblatt hast du das gesamte Alphabeth von A bis Z und in den Zellen daneben den dazugehörigen Text.

A - Buchstabe A
B - Buchstabe B
B - zweiter Buchstabe
C - Buchstabe C
.
.
.
S - Buchstabe S
S - Buchstabe vor dem T
S - zwei Buchstaben vor dem U
T .....
U ...
V
.
.
Z

das hatte ich gemeint mit: das Material kommt hier(zweites Tabellenblatt) mehrmals vor.....

(mein) Makro soll erkennen das es mehr "S" in der zweiten Tabelle gibt, entsprechend Platz schaffen und die neuen Texte einfügen.

Grüße
Stefano

Antwort 5 von StefanoInNot

Abend!

Damit hab ichs hinbekommen, kann da wer drüberschauen ob auch alles in Ordnung ist......

Sub nr2()
x = Tabelle3.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y = Tabelle4.UsedRange.SpecialCells(xlCellTypeLastCell).Row

Sheets("Tabelle4").Select

z4 = 1
s4 = 1

For z4 = 1 To y
Cells(z4, s4).Select
buchstabe4 = ActiveCell.Value

Sheets("Tabelle3").Select

z3 = 1
s3 = 1

For z3 = 1 To x
Cells(z3, s3).Select
Buchstabe3 = ActiveCell.Value

If Buchstabe3 = buchstabe4 Then

Sheets("Tabelle4").Select

Union( _
Cells(z4, s4), _
Cells(z4, 2), Cells(z4, 3), _
Cells(z4, 4), Cells(z4, 5), _
Cells(z4, 6), Cells(z4, 7), _
Cells(z4, 8), Cells(z4, 9)).Copy

Sheets("Tabelle5").Select

z5 = 1
s5 = 1

Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Select

Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Tabelle3").Select

End If

Next z3

Sheets("Tabelle4").Select

Next z4

End Sub

Danke,
Schönen Abend noch

Stefano