Office: Zeile nach Wort durchsuchen und alle übereinstimmenden Spalten markieren

Hallo liebe Experten,

ich bin leider ein ziemlicher Excel(2007)VBA-Anfänger, deswegen hoffe ich, dass ihr mir weiterhelfen könnt! (Eigentlich bin ich mir sicher, dass ihr das könnt;-))

Ich möchte, dass Excel eine bestimmte Zeile nach einem Bestimmten Wort (z.B. Äpfel) durchsucht und all die Spalten (auch insgesamt mit fester Range)mit diesem Wort markiert und in ein neues Tabellenblatt kopiert!
Wie durchläuft er die Spalten und markiert mehrere?

VBA deswegen, weil ich diese Makros an ein CommandButton dranhängen möchte!

Würd mich sehr freuen, wenn ihr mir da weiterhelfen könntet!
VG
James

:)

 

Hallo James,

Sub copyColumns()
Dim objsh As Worksheet
Dim rng As Range, rngC As Range
Dim strFirst As String

Set rng = Rows(2).Find(What:="Apfel", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, After:=Cells(2, Columns.Count))
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If rngC Is Nothing Then
Set rngC = rng.EntireColumn
Else
Set rngC = Union(rngC, rng.EntireColumn)
End If
Set rng = Rows(2).FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
End If

If Not rngC Is Nothing Then
Set objsh = ThisWorkbook.Worksheets.Add
rngC.Copy objsh.Cells(1, 1)
End If


Set rng = Nothing
Set rngC = Nothing
Set objsh = Nothing
End Sub





« Gruß Sepp »

 

Hey Josef,
Vielen Dank für die schnelle Antwort!!
Das klappt super!:-))
Jetzt habe ich nur 4 Tabellenblätter. Die Zeile bleibt gleich, aber wie kann er in allen Blättern suchen? Das muss was mit 'ThisWorkbook' zu tun haben, oder?
Viele Grüße!!

 

Mir ist noch was kleines ein/aufgefallen: Wie kann er auch Zeilen auswählen, wenn in dem Column neben Äpfel noch '(rot)' steht? also Z.b. Äpfel (rot)
Sobald er das Wort findet, egal ob noch was daneben steht, so meine ich das.
Geht das auch?

 

Hallo James,

geht alles, nur sollten wir vorher einige klären.

• Soll in allen Tabellen gesucht werden, oder nur in bestimmten?
  
• Sollen die gefundenen Spalten hintereinander in das neue Blatt kopiert werden, oder unten angehängt, oder ...?

« Gruß Sepp »

 

Hey Josef,
also in meiner Datei habe ich nur 4 Tabellen und da wird maximal noch eine hinzukommen, wahrscheinlich aber keine. Alle vier sind gleich aufgebaut, denn es handelt sich um einen Vergleich. Was allerdings richtig ist ist, dass er zum einen in allen suchen kann wenn er vorher keine einschränkung bekommen hat, aber ich/man auch die möglichkeit habe/hab vorher mich eben durch eine auswahl auf nur eine zu beschränken. beide wege sollten aber möglich sein. geht das?

Genau! Die Spalten sollten hintereinander/nebeneinander in das neue Blatt kopiert werden. So wie deine Lösung von Gestern macht er dies ja auch in der Reihenfolge wie in der Tabelle, die er durchsucht, oder?

Danke für deine kompetente Hilfe!!
Grüße
James

 

Hallo James,

folgender Code such in allen ausgewählten Tabellen, also Tabelle(n) auswählen und Makro starten.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub copyColumns()
Dim objSh As Worksheet, objShNew As Worksheet, objSelected As Object
Dim rng As Range, rngC As Range
Dim strFirst As String
Dim lngIndex As Long, lngCalc As Long

Const clngSearchRow As Long = 2 'Suchzeile

On Error GoTo ErrExit

With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = -4135
.DisplayAlerts = False
End With

lngIndex = 1

Set objSelected = ActiveWindow.SelectedSheets

objSelected.Item(1).Select True

Set objShNew = ThisWorkbook.Worksheets.Add(After:=objSelected.Item(objSelected.Count))

For Each objSh In objSelected
Set rng = Nothing
Set rngC = Nothing
strFirst = ""
Set rng = objSh.Rows(clngSearchRow).Find(What:="Apfel", LookIn:=xlValues, LookAt:=xlPart, _
MatchCase:=False, After:=objSh.Cells(clngSearchRow, objSh.Columns.Count))
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If rngC Is Nothing Then
Set rngC = rng.EntireColumn
Else
Set rngC = Union(rngC, rng.EntireColumn)
End If
Set rng = objSh.Rows(2).FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
End If

If Not rngC Is Nothing Then
rngC.Copy objShNew.Cells(1, lngIndex)
lngIndex = lngIndex + rngC.Areas.Count
End If
Next

ErrExit:

With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'copyColumns'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - copyColumns"
.Clear
End If
End With

On Error GoTo 0

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
.StatusBar = False
End With

Set rng = Nothing
Set rngC = Nothing
Set objSh = Nothing
Set objShNew = Nothing
Set objSelected = Nothing
End Sub





« Gruß Sepp »

 

Hey Josef!
Herzlichen Dank!!
Ich werde es morgen direkt ausprobieren! Leider bin ich gerade verhindert!
HG
James

 

PbhnFANZ ghd flat iron canada
txovYXOll http://www.ghdcanadaflatiron.info
nqeyytszcu ghd hair straighteners singapore
JAQbQerex gmfkzf ghd singapore
TgcNFZFDcfg

 

Hey Josef,

Herzlichen Dank für deine tolle Hilfe! Klappt genauso wie ich es mir vorstelle!
Leider lag ich die letzten Tage flach und komme erst jetzt wieder zum antworten.

Ich würde die Lösung gerne noch mit zwei weiteren Stichworten kombinieren, die in der gleichen Zeile auftauchen. Ich habe es schon mit mehreren Variationen versucht, aber leider stoß ich wieder schnell an meine VBA-Kenntnisse.
Wie schaffe ich es, dass alle drei (oder nur zwei, oder wie oben nur eine) Suchfunktionen ihre Spalten in EINE neue Tabelle kopieren?

Wahrscheinlich ist die Lösung trivial, ich bin aber zu blöd!
Viele Grüße
James

 

Hey Josef,
ich hab mir einen ähnlichen Post von dir im Forum durchgelesen, dessen Ansatz man doch teilweise übertragen könnte.

"Wie müsste man den Code umschreiben, dass das Makro den ersten Begriff sucht, falls es diesen findet die Spalte einfügt und danach weiter nach dem nächsten Begriff sucht, kopiert und einfügt, sollte ein Begriff nicht gefunden werden einfach mit dem nächsten Begriff weiter macht?"

Ich habe 3 Checkboxen, die jeweils einen Suchbegriff in ein und derselben Zeile suchen.
Je nachdem ob sie ausgewählt sind, können sie doch den Code wiederholt durchlaufen und die Daten ins GLEICHE Tabellenblatt kopieren (s.o.) oder?
Wahrscheinlich stelle ich es mir leichter vor als es ist.. ich scheitere schon an der Kombinierung!

Viele Grüße
James

 

Hallo James,

"Ich habe 3 Checkboxen, die jeweils einen Suchbegriff in ein und derselben Zeile suchen"

Dann hat du bestimmt schon eine Datei mit der du arbeitest. Checkboxen in der Tabelle oder auf UserForm? Suchtext=CheckBox-Beschriftung?

Lade doch deine Datei hoch.




« Gruß Sepp »

 

Hi Josef,
das hast du vollkommen richtig verstanden! Suchtext= CheckBox-Beschriftung auf der Userform!

Ich hab die ganzen Daten rausgeschmissen und nur die wesentlichen beispielhaft dringelassen. Wie man leicht erkennen kann geht es um eine einfache Vergleichsdatenbank für Hybride. Weil hoch aktuell;-)

Herzliche Grüße und ich kann mich gar nicht genug bedanken!
James

 

Mir ist gerade noch ein- bzw. aufgefallen, dass wenn er nach "HEV" sucht, natürlich auch P"HEV" markiert. kann man PHEV als Ausnahme gestalten?
Konnte dazu nichts finden:-/
VG!

 

Hallo Philipp,

teste mal.




« Gruß Sepp »