Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Selectieren

Forumthread: Selectieren

Selectieren
10.07.2022 11:14:47
siegfried
Guten Morgen zusammen,
ich habe eine Tabelle, wenn der Name in der Spalte D12:D43 eingegeben wird soll dieser Name
in der Zeile T13:AA13 gesucht werden und dann in der Spalte 13:21 makiert werden.
mfg
siegfried
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Habe mal dies zusammengestellt
10.07.2022 12:41:16
siegfried
Hallo zusammen,
habe mir mal dies "zusammengebastelt", funktioniert soweit, suche jetzt noch,
wenn der Curser nicht im Bereich D12:D43 steht soll Hinweis kommen,
"Falscher bereich".

Sub Selektion_Matrix_suchen_selectieren()
With ActiveSheet
Dim Zelle As Range
Dim az
Set az = Range("D12:D43").ActiveCell
'--- erst vorhandener Bereich Grau entfernen ---
Range("T13:AA21").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
az.Select
Set Zelle = .Range("T13:AA13").Find(What:=ActiveCell.Value)
Zelle.Select
End With
'------ jetzt Bereich Grau färben --------
With ActiveCell
Range(.Offset(8, 0), .Offset(0, 0)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End With
az.Select  'zurück zur ausgewählten Stelle in Bereich Spalte D
End Sub
mfg
siegfried
Anzeige
Nachfrage
10.07.2022 14:01:28
ralf_b
bestehst du auf diese ganzen Selections? Die sind meist unnötig.
und " Set az = Range("D12:D43").ActiveCell" ist falsch aber das weist du ja.
Hier böte sich an if intersect( Range("D12:D43"),ActiveCell) is nothing msgbox "Falscher Bereich"
Hallo Ralf Supi
10.07.2022 17:01:44
siegfried
Hallo Ralf,
danke für die Unterstützung !
Anbei:

Sub Selektion_Matrix_suchen_selectieren()
Dim Zelle As Range
Dim az
Set az = ActiveCell
If Intersect(Range("D12:D43"), ActiveCell) Is Nothing Then
MsgBox "Falscher Bereich"
Else
'MsgBox "jetzt"
With ActiveSheet
'--- erst vorhandener Bereich Grau entfernen ---
Range("T13:AA21").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
az.Select
Set Zelle = .Range("T13:AA13").Find(What:=ActiveCell.Value)
Zelle.Select
'------ jetzt Bereich Grau färben --------
With ActiveCell
Range(.Offset(8, 0), .Offset(0, 0)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End With
End With
az.Select  'zurück zur ausgewählten Stelle in Bereich Spalte D
End If
End Sub
jetzt binde ich es noch in die:
Private

Sub Worksheet_Change(ByVal Target As Excel.Range)
ich hoffe ich krieg es gleich hin.
Melde mich...
mfg siegfried

Anzeige
AW: Hallo Ralf Supi
10.07.2022 18:07:33
ralf_b
für den Fall das du dein Machwerk mal vergleichen willst. Hier ein Vorschlag ungetestet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zelle As Range
If Intersect(Range("D12:D43"), Target) Is Nothing Then
MsgBox "Falscher Bereich"
Else
'--- erst vorhandener Bereich Grau entfernen ---
With Range("T13:AA21").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Set Zelle = Range("T13:AA13").Find(What:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
'------ jetzt Bereich Grau färben --------
With Zelle.Resize(8).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Target.Select        'zurück zur ausgewählten Stelle in Bereich Spalte D
End If
End Sub

Anzeige
Hallo Ralfb PERFEKT Super DANKE ! -)
10.07.2022 18:36:56
siegfried
nicht mein Thema owt
10.07.2022 23:17:54
ralf_b
Anzeige
Herzlichen Dank für die Info -)
11.07.2022 09:11:31
siegfried
Bereich erweitern !
11.07.2022 09:20:02
siegfried
Guten Morgen Ralf,
ich möchte gern den Bereich erweitern.
So geht es nicht:
'--- erst vorhandener Bereich Grau entfernen ---
With Range("T13:AA21") & ("T33:AA41").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'----------------------------
Set Zelle = Range("T13:AA13" & "T33:AA41").Find(What:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
mfg siegfried
Anzeige
Ich habe es jetzt so geregelt aber vielleicht...
11.07.2022 09:58:40
siegfried
Guten Morgen,
ich habe es jetzt so geregelt und funktioniert:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zelle As Range
If Intersect(Range("D12:D43"), Target) Is Nothing Then
'' MsgBox "Falscher Bereich"
Else
'--- erst vorhandener Bereich Grau entfernen ---
With Range("T13:AA21").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Set Zelle = Range("T13:AA13").Find(What:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
'------ jetzt Bereich Grau färben --------
With Zelle.Resize(9).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
'''  Target.Select        'zurück zur ausgewählten Stelle in Bereich Spalte D
End If
'----------- 2 Matrix -------------------------------------------------------
If Intersect(Range("D12:D43"), Target) Is Nothing Then
'' MsgBox "Falscher Bereich"
Else
'--- erst vorhandener Bereich Grau entfernen ---
With Range("T33:AA41").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Set Zelle = Range("T33:AA41").Find(What:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
'------ jetzt Bereich Grau färben --------
With Zelle.Resize(9).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End If
Target.Select        'zurück zur ausgewählten Stelle in Bereich Spalte D
End If
End Sub
ist einfach "gestrickt" aber für meine Kenntnisse i.o., vielleicht gibt es eine "kurze" Version !
mfg siegfried
Anzeige
AW: Ich habe es jetzt so geregelt aber vielleicht...
11.07.2022 13:35:53
ralf_b
union(Bereich1, Bereich2) ergibt eine Range aus beiden Bereichen.
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige