Registriert seit: 05.11.2016
Version(en): 2010
Hallo liebes Forum,
ich habe folgendes Problem:
ich möchte 1) die Spalte A durchsuchen. Die Zeilen in Spalte A sind mit einzelnen Worten befüllt.
Dabei handelt es sich um wieder gleichen Worte.
Ich suche einen Code, der die Spalte A nach diesen Worten durchsucht aber immer nur einmal
berücksichtigt.
Ich glaube ich habe dazu mit .Advanced Filter ...Unique:=True ein brauchbares Instrument gefunden.
.AdvancedFilter enthält ja schon die Möglichkeit zu kopieren aber zweitens möchte ich die gefundenen Worte
in einem anderen Tabellenblatt als Spaltenüberschrift nutzen.
Dazu würde ich .SpecialPaste ...,Transponse:=True nutzen.
Ich weiß aber leider nicht wie ich .AdvancedFilter mit . SpecialPaste kombinieren kann.
Kann mit jemand helfen?
Gruß
tmessers
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo,
so in der Art:
Sub Makro1()
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = Worksheets("Tabelle1")
Set wsZ = Worksheets("Tabelle2")
With wsQ.Range("A1").CurrentRegion.Columns(1)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Offset(1).Resize(.Rows.Count - 1).Copy
End With
wsZ.Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
wsQ.ShowAllData
End Sub
Gruß Uwe
Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28
• tmessers
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo
mal auf die schnelle ein Makro, das die Aufgabe lösen kann. Bitte in ein Modulblatt kopieren und die Namen der Tabellen noch prüfen, ggf. in der Const Anweisung aendern. Zum Testen steht dort "Tabelle 1 + 2". Ich sortiere die Überschrift aber nicht!
mfg Gast 123
Code:
Option Explicit '6.2.2017 Gast 123 Clever Forum
Const Tab1 = "Tabelle1" 'Name der Quell Tabelle eintragen
Const Tab2 = "Tabelle2" 'Name der Ziel Tabelle eintragen
Sub SpaltenÜberschrift_ausfüllen()
Dim AC As Object, Spa As Integer
Dim TB1 As Worksheet, rFind As Object
Dim TB2 As Worksheet, EndAdr As String
Set TB1 = Worksheets(Tab1)
Set TB2 = Worksheets(Tab2)
'End-Adresse in Spalte "A" Tabelle1
EndAdr = TB1.Cells(Rows.Count, 1).End(xlUp).Address
Spa = 1 '1.Spalte in Tabelle2 als Spalten-Überschrift
'Schleife für alle Namen in Spalte "A"
For Each AC In TB1.Range("A1", EndAdr)
If AC.Value <> Empty Then
'Prüfen ob Namen in Tabelle2 bereits vorkommt
Set rFind = TB2.Range("A1").Resize(1, Spa + 1).Find(What:=AC, After:= _
Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'Wenn "Nein" Überschrift setzen
If rFind Is Nothing Then
TB2.Range("A1").Cells(1, Spa) = AC.Value
Spa = Spa + 1
End If
End If
Next AC
End Sub
Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:1 Nutzer sagt Danke an Gast 123 für diesen Beitrag 28
• tmessers
Registriert seit: 05.11.2016
Version(en): 2010
@Uwe
DAnke wieder einmal für Deine Hilfe.
Der Code funktioniert wieder wunderbar!!
@Gast123
Dir auch danke. Auch der Code führt zum gewünschten Ergebnis.
Registriert seit: 29.09.2015
Version(en): 2030,5
Code:
Sub M_snb()
Sheet1.Columns(1).AdvancedFilter 2, , Sheet2.Cells(1), -1
Sheet2.Cells(1).Resize(, Sheet2.Cells(1).CurrentRegion.Rows.Count) = Application.Transpose(Sheet2.Cells(1).CurrentRegion)
Sheet2.Columns(1).Delete
End Sub
Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:1 Nutzer sagt Danke an snb für diesen Beitrag 28
• tmessers