Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1636to1640
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
Inhaltsverzeichnis

Sub Colored

Sub Colored
15.08.2018 12:01:48
Franky
Hallo zusammen,
ich habe diese Makro gefunden zu dem ich nun eine Frage habe. Sub Colored() Dim R As Long Application.ScreenUpdating = False For R = 1 To 500 If InStr(Cells(R, 3).Value, "Hamburg") Then 'Wenn Hamburg irgendwo in der Zelle _ vorkommt Range(Cells(R, 1), Cells(R, 3)).Interior.Color = 10092543 End If Next Application.ScreenUpdating = True End Sub
Kann man dieses Makro um einige Städte erweitern und wenn ja wie? Hätte vielleicht jemand einen Ansatz für mich?
Vielen Dank und einen schönen Restmittwoch.
mfg Frank

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sub Colored
15.08.2018 12:11:52
Sepp
Hallo Frank,
dazu braucht man kein VBA.
Tabelle4

 BCDEFGHIJ
1 In Hamburg ist es schön.    Hamburg  
2 In München regnet es.    Berlin  
3 In Berlin scheint die Sonne.       
4 In Frankfurt ist es windig.       
5 In Hamburg ist es heiß.       
6         
7         
8         
9         

Bedingte Formatierungen der Tabelle
ZelleNr.: / BedingungFormat
C11. / Formel ist =SUMME(ZÄHLENWENN(C1;"*"&$H$1:$H$2&"*"))>0Abc


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Sub Colored
15.08.2018 14:38:51
Franky
Hallo Sepp,
danke für deine rasche Information. Ich suche aber nach einer VBA Lösung.
Gruß Frank
AW: Sub Colored
15.08.2018 14:56:37
Sepp
Hallo Frank,
auch kein Problem.
Sub Colored()
  Dim rng As Range, rngC As Range, strFirst As String
  Dim lngIndex As Long, varSearch As Variant

  varSearch = Array("Hamburg", "Berlin")
     
  For lngIndex = 0 To Ubound(varSearch)
    strFirst = ""
    Set rng = Range("C:C").Find(What:=varSearch(lngIndex), LookIn:=xlValues, _
      LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
      
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If rngC Is Nothing Then
          Set rngC = rng
        Else
          Set rngC = Union(rngC, rng)
        End If
        Set rng = Range("C:C").FindNext(rng)
      Loop While Not rng Is Nothing And rng.Address <> strFirst
    End If
  Next

  If Not rngC Is Nothing Then rngC.Interior.Color = 10092543

  Set rngC = Nothing
  Set rng = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Sub Colored
15.08.2018 16:27:00
Franky
Hallo Sepp,
das funktioniert sehr gut, vielen Dank. Ein kleines Problem noch, der andere Code färbt die Zellen von A bis Z. Geht das bei diesem auch ?
Gruß Frank
AW: Sub Colored
15.08.2018 16:37:31
Sepp
Hallo Frank,
dein ursprünglicher Code färbt die Spalte A:C nicht A:Z!
Ändere die Zeile
  If Not rngC Is Nothing Then rngC.EntireRow.Interior.Color = 10092543

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


dann wird die gesamte Zeile gefärbt.
Sonst beschreibe noch mal genauer, welche Spalten gefärbt werden sollen.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Sub Colored
15.08.2018 16:58:37
Franky
Hallo Sepp,
du hast natürlich Recht, hatte es nur hier schon abgeändert. Dein Code läuft auch gut, hört aber nicht bei Z auf sondern "rennt" durch. Geht das noch zu ändern? Das wäre sehr nett. Färben soll er wenn in Spalte C Hamburg oder eine andere Stadt stehen die Zellen A bis Z.
Gruß Frank
AW: Sub Colored
15.08.2018 17:00:51
Sepp
Hallo Frank,
Sub Colored()
  Dim rng As Range, rngC As Range, strFirst As String
  Dim lngIndex As Long, varSearch As Variant

  varSearch = Array("Hamburg", "Berlin", "München")
     
  With Range("C:C")
    .Offset(0, -2).Resize(, 26).Interior.ColorIndex = xlNone
    For lngIndex = 0 To Ubound(varSearch)
      strFirst = ""
      Set rng = .Cells.Find(What:=varSearch(lngIndex), LookIn:=xlValues, _
        LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
      
      If Not rng Is Nothing Then
        strFirst = rng.Address
        Do
          If rngC Is Nothing Then
            Set rngC = rng.Offset(0, -2).Resize(, 26)
          Else
            Set rngC = Union(rngC, rng.Offset(0, -2).Resize(, 26))
          End If
          Set rng = .Cells.FindNext(rng)
        Loop While Not rng Is Nothing And rng.Address <> strFirst
      End If
    Next
  End With

  If Not rngC Is Nothing Then rngC.Interior.Color = 10092543

  Set rngC = Nothing
  Set rng = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Sub Colored
15.08.2018 17:20:47
Franky
Hallo Sepp,
das läuft jetzt genauso wie ich es mir vorgestellt habe. Du hast mir sehr geholfen. Recht herzlichen Dank dafür. Ich wünsche dir noch einen schönen Abend und eine stressfreie Woche.
Gruß Frank
@Sepp nachgefragt: Sub Colored
15.08.2018 20:12:11
Gerhard
Hallo Sepp,
wie könnte ich die Zeile varSearch = Array("Hamburg", "Berlin", "München") variabel machen?
etwa so: varSearch = Array(Range("H1:H5")) ?
Ist das möglich?
Gruß
Gerhard
AW: @Sepp nachgefragt: Sub Colored
15.08.2018 20:26:08
Sepp
Hallo Gerhard,
klar geht das.
Sub Colored()
  Dim rng As Range, rngC As Range, strFirst As String
  Dim lngIndex As Long, varSearch As Variant

  varSearch = Range("H1:H5")
     
  With Range("C:C")
    .Offset(0, -2).Resize(, 26).Interior.ColorIndex = xlNone
    For lngIndex = 1 To Ubound(varSearch, 1)
      strFirst = ""
      If varSearch(lngIndex, 1) <> "" Then
        Set rng = .Cells.Find(What:=varSearch(lngIndex, 1), LookIn:=xlValues, _
          LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
      
        If Not rng Is Nothing Then
          strFirst = rng.Address
          Do
            If rngC Is Nothing Then
              Set rngC = rng.Offset(0, -2).Resize(, 26)
            Else
              Set rngC = Union(rngC, rng.Offset(0, -2).Resize(, 26))
            End If
            Set rng = .Cells.FindNext(rng)
          Loop While Not rng Is Nothing And rng.Address <> strFirst
        End If
      End If
    Next
  End With

  If Not rngC Is Nothing Then rngC.Interior.Color = 10092543

  Set rngC = Nothing
  Set rng = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige