Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
336to340
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
336to340
336to340
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Spalte durchsuchen

Spalte durchsuchen
13.11.2003 15:22:49
Stefan
hilfe liebe excel könner,
ich habe eine tabelle mit einer jahresskala (zeile 1, b bis z)
in den zeilen darunter (2 bis 30) sind unter den jahreszahlen, ganz unterschiedlich,
zellen mit einem x markiert, immer zwei pro zeile.
ich würde gerne die zeilen nach den x(en) durchsuchen lassen und dann den
zwischenraum zwischen beiden farbig markieren!

geht das irgend wie?

vielen dank für die hilfe

gruß stefan

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte durchsuchen
13.11.2003 15:51:07
Nayus
Hi,
folgendes Makro erledigt die Aufgabe (markiert den Zwischenraum in gelb)

Gruß,
Nayus


Sub MarkBetween()
Dim xCnt, x1pos As Integer
Dim mRange As String
'Alle evtl. Einfärbungen zurücknehmen
Range("B1:X30").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlNone
End With
For i = 2 To 30
'Zeile 2 bis 30
xCnt = 0
x1pos = 0
x2pos = 0
For j = 2 To 26
'Spalte B bis Z
If UCase(ActiveSheet.Cells(i, j)) = "X" Then
xCnt = xCnt + 1
If xCnt = 1 Then
x1pos = j
ElseIf xCnt = 2 Then
'zweites X gefunden, Markierung setzen und raus
If j - x1pos > 1 Then
' markierbarer Bereich gefunden
mRange = Chr(64 + x1pos + 1) & CStr(i) & ":" & Chr(64 + j - 1) & CStr(i)
Range(mRange).Select
'Zwischenraum gelb einfärben
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Exit For
End If
End If
Next j
Next i
End Sub

Anzeige
Spitzenmäßig
13.11.2003 16:10:37
Stefan
Vielen dank genau das habe ich gesucht!!!
AW: Spitzenmäßig
13.11.2003 16:12:51
Nayus
Danke für die Rückmeldung, gern geschehen
Gruß,
Nayus
AW: Spalte durchsuchen
13.11.2003 15:59:01
Jessica
Hallo Stefan,

habe getüftelt und habs geschafft...
Gruß,

Jessica

Private Sub Worksheet_activate()
For i = 2 To 20
For j = 1 To 26
If Cells(i, j).Interior.ColorIndex = xlNone Then
If Cells(i, j).Value = "x" And Cells(i, j + 1) <> "x" Then
Cells(i, j + 1).Select
Selection.Interior.ColorIndex = 3
ElseIf Cells(i, j).Value = "" Then
Cells(i, j + 1).Select
Selection.Interior.ColorIndex = xlNone
End If
Else
If Cells(i, j + 1).Value = "x" Then
Cells(i, j + 1).Select
Selection.Interior.ColorIndex = xlNone
a = j + 1
For b = a To 26
Cells(i, b).Select
Selection.Interior.ColorIndex = xlNone
Next
GoTo zeile:
ElseIf Cells(i, j).Value = "" Then
Cells(i, j + 1).Select
Selection.Interior.ColorIndex = 3
End If
End If
Next
zeile:
Next
End Sub

Anzeige
Vielen Dank dafür
13.11.2003 16:13:31
Stefan
Super hat mir echt sehr geholfen
AW: Spalte durchsuchen
13.11.2003 16:20:53
PeterW
Hallo Stefan,

mal noch ein Ansatz ohne Select:

Sub ZwischenraumFaerben()
Dim iCol As Integer
Dim lgRow As Long
For lgRow = 2 To 30
For iCol = 2 To 26
If Cells(lgRow, iCol) = "x" Then
Do
Cells(lgRow, iCol).Interior.ColorIndex = 3
iCol = iCol + 1
Loop Until Cells(lgRow, iCol) = "x"
Cells(lgRow, iCol).Interior.ColorIndex = 3
Exit For
End If
Next
Next
End Sub

Gruß
Peter
Frage und Danke
13.11.2003 16:48:14
Stefan
auch dir tausend dank!
könnte ich auch eine bereich zwischen zwei unterschiedlichen buchstaben markieren?
sagen wir a für anfang und e für ende?
Anzeige
AW: Frage und Danke
13.11.2003 17:03:43
PeterW
Hallo Stefan,

bei dieser Version ist es egal, welche Buchstaben/Zahlen in den Zellen stehen. Es wird nur unterschieden nach leer oder nicht leer.

Sub ZwischenraumFaerben()
Dim iCol As Integer
Dim lgRow As Long
For lgRow = 2 To 30
For iCol = 2 To 26
If Not IsEmpty(Cells(lgRow, iCol)) Then
Do
Cells(lgRow, iCol).Interior.ColorIndex = 3
iCol = iCol + 1
Loop Until Not IsEmpty(Cells(lgRow, iCol))
Cells(lgRow, iCol).Interior.ColorIndex = 3
Exit For
End If
Next
Next
End Sub

Gruß
Peter
Nochmal VIELEN DANK
14.11.2003 10:56:34
Stefan
danke

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige