AW: Hi Franc
27.12.2004 22:44:21
Franc
du kannst auch die Tabelle posten und ich ändere das ab.
oder
1. öffne das Notepad
2. markiere den Zellbereich P1:P2000 (das kannst ja so oben links im Namensfeld eintragen) - vorrausgesetzt die gesamten Daten stehen im angegebenen Bereich
3. strg + c
4. zum Notepad wechseln und "Rechtsklick" einfügen (oder strg + v)
Das ist deshalb notwendig, damit der Inhalt erhalten bleibt aber sämtliche Formatierungen verloren gehen.
5. zu excel zurück und die Spalten O - R markieren und rechtsklick "Inhalte löschen" wählen
6. zum Notepad wechseln und mit strg + a alles markieren und mit strg + c kopieren
7. in Excel Zelle P1 anklicken und strg + v drücken.
fertig
jetzt das makro starten
(Ich habe nochmal Erklärungen ins Makro geschrieben)
Sub p_zu_r()
p_zu_r:
Set p_name = [P1].End(xlDown)
' p_name (der name selbst ist variabel) weise ich hiermit
' die 1. belegte Zelle in Spalte P zu.
If p_name = leer Then GoTo ende
' wenn nur noch leere Zellen in der Spalte P stehen,
' wird das Makro beendet.
With ActiveSheet.[R2:R65536]
' hiermit prüfe das Makro ob es den Namen der aktuell in
' Spalte P gewählt ist, schon in Spalte R drinsteht
Set doppel = .Find(p_name, LookIn:=xlValues, LookAt:=xlWhole)
' jetzt suchen wir ob der Name schon vorhanden ist (p_name als Variable)
' ganz wichtig ist "LookAt:=xlWhole", weil er den gesamten Inhalt vergleicht
' und nicht nur einen Teil
If Not doppel Is Nothing Then
' Wenn der Name nicht gefunden wird dann ist nichts (wörtlich übersetzt)
p_name.Clear
GoTo p_zu_r
' Wenn der Name schon vorkommt, dann wird die aktuelle Auswahl in Spalte P
' gelöscht und das makro beginnt wieder von vorn (durch das goto)
End If
End With
p_name.Cut
' falls der Eintrag noch nicht vorkam, wird der aktuelle Eintrag
' aus Spalte P ausgeschnitten
[R65536].End(xlUp).Offset(1, 0).Select
' Jetzt wird die 1. belegte Zelle von unten (zelle R65536) aus gesehen in
' Spalte R gesucht und mit Offset 1,0 die Zelle darunter markiert
' deshalb sollte auch in Spalte R idealerweise noch nichts stehen
ActiveSheet.Paste
GoTo p_zu_r
'der name wird eingefügt und das Makro fängt von vorn an
ende:
[R1].Select
End Sub