Spalte durchsuchen

Bild

Betrifft: Spalte durchsuchen
von: Stefan
Geschrieben am: 13.11.2003 15:22:49

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

Bild


Betrifft: AW: Spalte durchsuchen
von: Nayus
Geschrieben am: 13.11.2003 15:51:07

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



Bild


Betrifft: Spitzenmäßig
von: Stefan
Geschrieben am: 13.11.2003 16:10:37

Vielen dank genau das habe ich gesucht!!!


Bild


Betrifft: AW: Spitzenmäßig
von: Nayus
Geschrieben am: 13.11.2003 16:12:51

Danke für die Rückmeldung, gern geschehen
Gruß,
Nayus


Bild


Betrifft: AW: Spalte durchsuchen
von: Jessica
Geschrieben am: 13.11.2003 15:59:01

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



Bild


Betrifft: Vielen Dank dafür
von: Stefan
Geschrieben am: 13.11.2003 16:13:31

Super hat mir echt sehr geholfen


Bild


Betrifft: AW: Spalte durchsuchen
von: PeterW
Geschrieben am: 13.11.2003 16:20:53

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


Bild


Betrifft: Frage und Danke
von: Stefan
Geschrieben am: 13.11.2003 16:48:14

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?


Bild


Betrifft: AW: Frage und Danke
von: PeterW
Geschrieben am: 13.11.2003 17:03:43

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


Bild


Betrifft: Nochmal VIELEN DANK
von: Stefan
Geschrieben am: 14.11.2003 10:56:34

danke


Bild

Beiträge aus den Excel-Beispielen zum Thema " Spalte durchsuchen"