Zellen automatisch markieren

Forumthread: Zellen automatisch markieren

18.01.2009 10:50:03

Judith

Hallo zusammen,
ich lerne seit kurzem VBA und bin dank Eurer Hilfe auch schon weit gekommen.
Jetzt habe ich wieder mal so eine Idee, die mich nicht mehr los lässt. Vielleicht kann mir jemand etwas weiterhelfen. Ich weiß nicht, ob ich auf dem Holzweg bin, deswegen poste ich hier.
Folgender Fall:
In eine Tabelle werden Namen und Arbeiteszeiten eingetragen. Daneben sollen sie Zellen markiert werden, die diesen Arbeitszeiten entsprechen. Die Anzahl der Mitarbeiter ist verschieden.
Siehe Beispieltabelle: https://www.herber.de/bbs/user/58542.xls
Meine Idee wäre folgende:
Zuerst die Letzte belegteZelle in diesem Bereicht ermitteln und dann den Zeilenwert in eine For- Next-Schleife eintragen.
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
und dann wahrscheinlich VLookUp oder Find oder IsLike.
Diese Funkitonen habe beim Googlen gefunden kann aber nicht wirklich was damit anfangen.
Eben so etwas wie die SVerweis Funktion von Excel.
Es wäre toll, wenn mir jemand einen Ansatz liefern könnte oder auch einen Beitrag empfehlen könnte.
Ich müsste sonst wahrscheinlich einige Hunderttausend Beiträge durchsehen, ich weiß eben nicht genau, wonach ich suchen soll.
Viele Grüße und einen schönen Sonntag!
Judith

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zellen automatisch markieren

18.01.2009 11:46:00

Josef
noch eine

18.01.2009 11:57:00

Tino
AW: Vielen Dank, Jungs!

18.01.2009 13:31:25

Judith
AW: Zellen automatisch markieren

18.01.2009 14:44:00

Peter
AW: Dir auch vielen Dank!

18.01.2009 15:11:00

Judith

AW: Zellen automatisch markieren

18.01.2009 11:46:00

Josef

Hallo Judith,
probier mal.
' **********************************************************************
' Modul: Tabelle4 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub CommandButton1_Click()
    Dim lngRow As Long, lngCol As Long, lngFirstCol As Long, lngLastCol As Long
    Dim lngStart As Long, lngEnd As Long

    On Error GoTo Errexit
    Application.ScreenUpdating = False

    lngFirstCol = 13
    lngLastCol = 68

    For lngRow = 2 To Application.Max(2, Cells(Rows.Count, 1).End(xlUp).Row)
        Range(Cells(lngRow, lngFirstCol), Cells(lngRow, lngLastCol)).Interior.ColorIndex = xlNone
        For lngCol = 4 To 8 Step 2
            If Application.Count(Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 1))) = 2 Then
                lngStart = Application.Min(lngLastCol - lngFirstCol, _
                    ((Application.Max(7, Hour(Cells(lngRow, lngCol))) - 7) * 4) + _
                    Int(Minute(Cells(lngRow, lngCol)) / 15))

                lngEnd = Application.Min(lngLastCol - lngFirstCol, _
                    ((Application.Max(7, Hour(Cells(lngRow, lngCol + 1))) - 7) * 4) + _
                    Int(Minute(Cells(lngRow, lngCol + 1)) / 15))

                Range(Cells(lngRow, lngFirstCol + lngStart), _
                    Cells(lngRow, lngFirstCol + lngEnd)).Interior.ColorIndex = 56
            End If
        Next
    Next

    Errexit:
    Application.ScreenUpdating = True
End Sub

Gruß Sepp

noch eine

18.01.2009 11:57:00

Tino

Hallo,
teste mal diesen Code.
Was soll aber sein, wenn zu dem Bis kein Von gibt oder zu dem Von kein Bis?
Ich habe diese ausgelassen.

Sub Test()
Dim Bereich As Range, Zelle As Range
Dim i As Long
Dim LCol1, LCol2

Set Bereich = Range("D2:I31")
Range("M2:BP100").Interior.ColorIndex = xlNone

For i = 2 To Bereich.Cells.Count Step 2
    If Bereich(i - 1) <> "" And Bereich(i) <> "" Then
         LCol1 = Application.Match(Bereich(i - 1), Rows(1), 1)
         LCol2 = Application.Match(Bereich(i), Rows(1), 1)
        
           If IsNumeric(LCol1) And IsNumeric(LCol2) Then
            Set Zelle = Range(Cells(Bereich(i).Row, LCol1), Cells(Bereich(i).Row, LCol2))
            Zelle.Interior.ColorIndex = 15
           End If
    End If
Next i

End Sub

Gruß Tino

AW: Vielen Dank, Jungs!

18.01.2009 13:31:25

Judith

Hallo Tino, hallo Josef,
vielen Dank für Eure Antworten!
Wie ich gesehen habe, seid Ihr beide ziemlich aktiv wenn es darum geht, den Frischlingen zu helfen. Eure Aufbauarbeit ist wirklich außerordentlich zu würdigen.....Das muss auch mal gesagt werden,....so!
@ Tino: Hast Recht, ich muss noch eine Bedingung einbauen, wenn kein Eintrag in den Zellen ist. Das schaffe ich bestimmt!
@ Josef: Bin gespannt was ich über die von Dir benutzten Funktionen rausfinde. Deine Idee war mir bis jetzt total unbekannt.
Viele Grüße und einen schönen Sonntag!
Judith

AW: Zellen automatisch markieren

18.01.2009 14:44:00

Peter

Hallo Judith,
hier noch eine driite Variante:
Option Explicit
'
' In eine Tabelle werden Namen und Arbeitszeiten eingetragen.
' Daneben, in einem separaten Tabellenteil sollen sie Zellen markiert werden,
' die diesen Arbeitszeiten entsprechen.
' Die Anzahl der Mitarbeiter ist verschieden.
'


Public Sub ZeitenMarkieren()
Dim lZeile     As Long       ' die Zeile der Mitarbeiter
Dim iSpalte_Q  As Integer    ' die Spalten D - I
Dim iSpalte_Z  As Integer    ' die Spalten M - BP
Dim iSpalte_S  As Integer    ' die neue Start-Spalte für die Bis-Zeit
Dim rBereich   As String     ' der Bereich, der zu markieren sein wird
With ThisWorkbook.Worksheets("Schichtplan")
.Range("M2:BP250").Interior.ColorIndex = xlNone ' alle farbigen Markierungen löschen
For lZeile = 2 To .Cells(Rows.Count, 1).End(xlUp).Row ' Zeile 2 bis Ende abarbeiten
For iSpalte_Q = 4 To 8 Step 2 ' die Spalten D - I paarweise abarbeiten
If Trim(.Cells(lZeile, iSpalte_Q).Value)  "" And _
Trim(.Cells(lZeile, iSpalte_Q + 1).Value)  "" Then ' Von-Bis gefüllt ?
If IsNumeric(.Cells(lZeile, iSpalte_Q).Value) Then ' Von nummerisch ?
For iSpalte_Z = 13 To 68 ' die Spalten M - BP abarbeiten
If Hour(.Cells(lZeile, iSpalte_Q).Value) = _
Hour(.Cells(1, iSpalte_Z).Value) And _
Minute(.Cells(lZeile, iSpalte_Q).Value) = _
Minute(.Cells(1, iSpalte_Z).Value) Then
If rBereich = "" Then ' die gefundene Zelladresse merken
rBereich = Spaltenbuchstabe(iSpalte_Z) & lZeile
Else
rBereich = rBereich & "," & Spaltenbuchstabe(iSpalte_Z) & lZeile
End If
iSpalte_S = iSpalte_Z + 1 ' die Folgespalte merken
Exit For                  ' For/Next hier verlassen
End If
Next iSpalte_Z
If IsNumeric(.Cells(lZeile, iSpalte_Q + 1).Value) Then ' Bis nummerisch ?
For iSpalte_Z = iSpalte_S To 68  ' nächste Spalte bis Ende durchsuchen
If Hour(.Cells(lZeile, iSpalte_Q + 1).Value) = _
Hour(.Cells(1, iSpalte_Z).Value) And _
Minute(.Cells(lZeile, iSpalte_Q + 1).Value) = _
Minute(.Cells(1, iSpalte_Z).Value) Then
rBereich = rBereich & ":" & Spaltenbuchstabe(iSpalte_Z) & lZeile
Exit For  ' For/Next hier, nachdem gefunden wurde, verlassen
End If
Next iSpalte_Z
End If
End If
End If
Next iSpalte_Q
Next lZeile
End With
If rBereich  "" Then ' wurden Übereinstimmungen gefunden ?
Range(rBereich).Interior.ColorIndex = 35 ' hellgrün markieren
End If
End Sub

'
' die nummerische Spalte in einen Spaltenbuchstaben umwandeln
'


Public Function Spaltenbuchstabe(SpaltenNummer As Integer) As String
Spaltenbuchstabe = Replace(Cells(1, SpaltenNummer).Address(0, 0), "1", "")
End Function

Gruß Peter

AW: Dir auch vielen Dank!

18.01.2009 15:11:00

Judith

Hallo Peter,
Du hast Dir echt viel Arbeit gemacht und vor allem auch eine Menge Kommentare eingebaut. Das erleichtert das Verstehen ungemein.
Vielen Dank dafür! Es wird sich noch etwas dauern bis ich alles analysiert habe ;-/
Schönen Tag noch!
Judith

Beliebteste Forumthreads (12 Monate)

Forumthread: Zellen automatisch markieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread