Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 12:09:19
Unique (Application.WorksheetFunction.Unique)
19.04.2024 11:51:37
Nächsten identischen Treffer suchen
19.04.2024 11:45:34
Feld im SAP auslesen
19.04.2024 10:59:29
Datei Auswählen und öffnen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1040to1044
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
1040to1044
1040to1044
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zellen automatisch markieren

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
Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige