Farben löschen

Forumthread: Farben löschen

Farben löschen

26.11.2015 11:18:27

Peter

Hallo zusammen,
mit diesem Code zähle ich meine Farben

Sub Farbe()
Dim x&, Farbe1, Farbe2, Farbe3, Farbe4, Farbe5, Farbe6, Farbe7, Farbe8, Farbe9, Farbe10,  _
Farbe11, Farbe12, Farbe13, Farbe14, Farbe15, Farbe16, Farbe17, Farbe18, Farbe19, Farbe20, RnG As Range
Dim Farbzahl1, Farbzahl2, Farbzahl3, Farbzahl4, Farbzahl5, Farbzahl6, Farbzahl7, Farbzahl8,  _
Farbzahl9, Farbzahl10, Farbzahl11, Farbzahl12, Farbzahl13, Farbzahl14, Farbzahl15, Farbzahl16, Farbzahl17, Farbzahl18, Farbzahl19, Farbzahl20
With Tabelle1
Farbe1 = .Cells(6, 207).Interior.Color
Farbe2 = .Cells(11, 207).Interior.Color
Farbe3 = .Cells(16, 207).Interior.Color
Farbe4 = .Cells(21, 207).Interior.Color
Farbe5 = .Cells(26, 207).Interior.Color
Farbe6 = .Cells(31, 207).Interior.Color
Farbe7 = .Cells(36, 207).Interior.Color
Farbe8 = .Cells(41, 207).Interior.Color
Farbe9 = .Cells(46, 207).Interior.Color
Farbe10 = .Cells(51, 207).Interior.Color
Farbe11 = .Cells(56, 207).Interior.Color
Farbe12 = .Cells(61, 207).Interior.Color
Farbe13 = .Cells(66, 207).Interior.Color
Farbe14 = .Cells(71, 207).Interior.Color
Farbe15 = .Cells(76, 207).Interior.Color
Farbe16 = .Cells(81, 207).Interior.Color
Farbe17 = .Cells(86, 207).Interior.Color
Farbe18 = .Cells(91, 207).Interior.Color
Farbe19 = .Cells(96, 207).Interior.Color
Farbe20 = .Cells(101, 207).Interior.Color
For Each RnG In .Range("Bereich")
Select Case RnG.Interior.Color
Case Is = Farbe1
Farbzahl1 = Farbzahl1 + 1
Case Is = Farbe2
Farbzahl2 = Farbzahl2 + 1
Case Is = Farbe3
Farbzahl3 = Farbzahl3 + 1
Case Is = Farbe4
Farbzahl4 = Farbzahl4 + 1
Case Is = Farbe5
Farbzahl5 = Farbzahl5 + 1
Case Is = Farbe6
Farbzahl6 = Farbzahl6 + 1
Case Is = Farbe7
Farbzahl7 = Farbzahl7 + 1
Case Is = Farbe8
Farbzahl8 = Farbzahl8 + 1
Case Is = Farbe9
Farbzahl9 = Farbzahl9 + 1
Case Is = Farbe10
Farbzahl10 = Farbzahl10 + 1
Case Is = Farbe11
Farbzahl11 = Farbzahl11 + 1
Case Is = Farbe12
Farbzahl12 = Farbzahl12 + 1
Case Is = Farbe13
Farbzahl13 = Farbzahl13 + 1
Case Is = Farbe14
Farbzahl14 = Farbzahl14 + 1
Case Is = Farbe15
Farbzahl15 = Farbzahl15 + 1
Case Is = Farbe16
Farbzahl16 = Farbzahl16 + 1
Case Is = Farbe17
Farbzahl17 = Farbzahl17 + 1
Case Is = Farbe18
Farbzahl18 = Farbzahl18 + 1
Case Is = Farbe19
Farbzahl19 = Farbzahl19 + 1
Case Is = Farbe20
Farbzahl20 = Farbzahl20 + 1
End Select
Next
.Cells(6, 208) = Farbzahl1
.Cells(11, 208) = Farbzahl2
.Cells(16, 208) = Farbzahl3
.Cells(21, 208) = Farbzahl4
.Cells(26, 208) = Farbzahl5
.Cells(31, 208) = Farbzahl6
.Cells(36, 208) = Farbzahl7
.Cells(41, 208) = Farbzahl8
.Cells(46, 208) = Farbzahl9
.Cells(51, 208) = Farbzahl10
.Cells(56, 208) = Farbzahl11
.Cells(61, 208) = Farbzahl12
.Cells(66, 208) = Farbzahl13
.Cells(71, 208) = Farbzahl14
.Cells(76, 208) = Farbzahl15
.Cells(81, 208) = Farbzahl16
.Cells(86, 208) = Farbzahl17
.Cells(91, 208) = Farbzahl18
.Cells(96, 208) = Farbzahl19
.Cells(101, 208) = Farbzahl20
End With
End Sub

Spalte GY sind meine Farben und in der Spalte GZ wird die farben gezählt.
kann man in diesen Tabellenblatt z.b. die Farbenfüllung einzeln löschen ?
z.b. habe ich
250 Zellen Gelb,
220 Zellen grün usw...
jetzt würde ich bei jede Spalte209 einen Button hinterlegen mit löschen.
Dann wir im ganzen Arbeitsblatt Tabelle 1 A1: GW 139 die Farbe Gelb gelöscht.
Grusß Peter

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Farben löschen

26.11.2015 11:43:50

Rudi
AW: Farben löschen

26.11.2015 16:38:12

peter

AW: Farben löschen

26.11.2015 11:43:50

Rudi

Hallo,
zuerst mal:

Sub Farbe()
Dim x&, Farbe(1 To 20), RnG As Range
Dim Farbzahl(1 To 20)
Dim i As Integer
With Tabelle1
For i = 1 To 20
Farbe(i) = .Cells(i * 5 + 1, 207).Interior.Color
Next i
For Each RnG In .Range("Bereich")
For i = 1 To 20
Farbzahl(i) = Farbzahl(i) - RnG.Interior.Color = Farbe(i)
Next
Next RnG
For i = 1 To 20
.Cells(i * 5 + 1, 208) = Farbzahl(i)
Next i
End With
End Sub

zur Frage:


Private Sub CommandButton1_Click()
FarbeLoeschen Range("GY6")
End Sub
Sub FarbeLoeschen(rngRef As Range)
Dim rng As Range, rngColor As Range
Dim lngColor As Long
lngColor = rngRef.Interior.Color
For Each rng In ActiveSheet.UsedRange
If Not rng.Address = rngRef.Address Then
If rng.Interior.Color = lngColor Then
If rngColor Is Nothing Then
Set rngColor = rng
Else
Set rngColor = Union(rngColor, rng)
End If
End If
End If
Next
If Not rngColor Is Nothing Then rngColor.Interior.Color = xlNone
End Sub

Gruß
Rudi

AW: Farben löschen

26.11.2015 16:38:12

peter

Hallo Rudi,
soll ich meine meinen Code löschen und deine beiden nehmen ?
Gruß peter

Beliebteste Forumthreads (12 Monate)

Forumthread: Farben löschen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread