Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1380to1384
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

Erstellung eines Arrays mit Loopfunktion

Erstellung eines Arrays mit Loopfunktion
13.09.2014 19:24:08
toteitote
Hallo miteinander,
ich habe gerade erst angefangen mich mit der Thematik VBA zu beschäftigen. In meiner Haushaltsliste habe ich 31 Labels zur Verfügung, die in Spalte 9 Worksheet 3 angegeben werden können. Ich bin bestrebt, dass die Farbkennung der Labels in der Spalte automatisiert wird und hoffe, mir kann jemand mit etwas Expertise helfen dies zu Codieren. Ich habe bisher noch keinen Erfolg verzeichnen können, was die Effektivität des Codes anbelangt. Ich habe 6 Gruppen von Elementen, die ich erstmal aufliste:
Gr.1: E1,E2,E3,EE1,EE2,EE3,EE4 (RGB(0, 128, 0)/Index Nr.10)
Gr.2: T1,T2,T3,T4,T5,TT1,TT2,TT3 (RGB(0, 204, 255)/Index Nr.28)
Gr.3: Z1,Z2,Z3 (RGB(153, 51, 0)/Index Nr.53)
Gr.4: U1,U2,U3 (RGB(153, 51, 102)/Index Nr.54)
Gr.5: K,TEC,NEC (RGB(51, 51, 51)/Index Nr.56)
Gr.6: STR,ENT,KUR,SOF,SER,ORG,RE (RGB(255, 0, 0)/Index Nr.3)
Ich habe einen gebrechlichen Anfang gewagt mit einem Loop ohne Dim oder Arrayparameter... Funktioniert leider nicht Ansatzweise und ich wäre Dankbar über den ein oder anderen Tip, wie das praktikabel in die Tat umzusetzen ist...
Sub Geldhaushalt()
Do While Col(9).Value = Empty
Select Case IsEmpty(ActiveCell)
Case True
Case Else
Select Case ActiveCell.HasText
Case True
If ActiveCell.Text = "E1" Then
ActiveCell.Interior.Color = RGB(0, 128, 0)
ElseIf ActiveCell.Text = "NEC" Then
ActiveCell.Interior.Color = RGB(51, 51, 51)
Else
ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Select
End Select
Loop
End Sub
Die Liste: https://www.herber.de/bbs/user/92613.xlsm

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

Betreff
Datum
Anwender
Anzeige
AW: Erstellung eines Arrays mit Loopfunktion
19.09.2014 13:40:46
Adis
Hallo
ich habe das obige Makro getestet, es laeuft nicht! Bekomme Run-Time Fehlermeldung
Dafür gibt es wahrscheinlich mehrere Gründe, Fehler im Programm und Denkfehler.
Der erste grundlegende Fehler liegt hier. Do While Col(9).Value = Empty
Die Spalte 9 ist ja nicht ganz leer, es gibt Daten und die Überschriftszeile.
Dann wird eine AktiveCelle ausgewertet, aber welche Zelle ist denn hier aktiv?
Das kann eine x beliebige sein, denn Aktiv ist gerade die wo der Cursor steht!
Probleme machten bei mir auch: .TintAndShade = 0 + .PatternTintAndShade = 0
Unklar ist der Befehl ClearContents, weil er ohne Bereichangabe nicht laeuft.
Ich habe das Programm mal soweit geaendert das es wenigstens über z=Zeile laeuft.
Die Kategorie haette ich über ein Makro ausgewrtet, anstatt so komplizierte Formeln.
Der FarbIndex laesst sich auch per Makro über die Spalte M ermitteln und einfügen.
Sub Geldhaushalt()
Dim z:  z = 4
Columns(9).Interior.ColorIndex = xlNone
Do Until Cells(z, "I") = Empty
Select Case IsEmpty(Cells(z, "I"))
Case True
Case Else
Select Case IsEmpty(Cells(z, "I"))
Case False
If Cells(z, "I").Text = "E1" Then
Cells(z, "I").Interior.Color = RGB(0, 128, 0)
ElseIf Cells(z, "I").Text = "NEC" Then
Cells(z, "I").Interior.Color = RGB(51, 51, 51)
Else
'                Cells(z, "I").ClearContents
With Selection.Interior
.Pattern = xlNone
.ColorIndex = xlNone
'                    .TintAndShade = 0
'                    .PatternTintAndShade = 0
End With
End If
End Select
End Select
z = z + 1
Loop
End Sub
Gruss Adis
PS eins kann mein Programm nicht: -finanzieren-

Anzeige
AW: Erstellung eines Arrays mit Loopfunktion
19.09.2014 16:37:38
Peter
Danke für die Antwort, ich habe an dem code mittlerweile einiges geändert, sodass das gedachte Array auch korrekt angesprochen wird. Es läuft jetzt alles, wie ich mir es vorgestellt habe;
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngcell As Range
Dim Bereich As Range
Set Bereich = ActiveSheet.Range(Cells(4, 9), Cells(1000, 9))
If Target.Column = 9 Then
For Each rngcell In Bereich
Select Case Trim$(rngcell.Value)
'Gruppe 1
Case "E1", "E2", "E3", "EE1", "EE2", "EE3", "EE4"
rngcell.Interior.Color = RGB(0, 128, 0)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'Gruppe 2
Case "T1", "T2", "T3", "T4", "T5", "TT1", "TT2", "TT3"
rngcell.Interior.Color = RGB(0, 204, 255)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'Gruppe 3
Case "Z1", "Z2", "Z3"
rngcell.Interior.Color = RGB(153, 51, 0)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'Gruppe 4
Case "U1", "U2", "U3"
rngcell.Interior.Color = RGB(153, 51, 102)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'Gruppe 5
Case "K", "TEC", "NEC"
rngcell.Interior.Color = RGB(51, 51, 51)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'Gruppe 6
Case "STR", "ENT", "KUR", "SOF", "SER", "ORG", "RE"
rngcell.Interior.Color = RGB(255, 0, 0)
rngcell.Interior.Pattern = xlGray50
rngcell.Font.Bold = True
rngcell.Font.Color = RGB(255, 255, 255)
'.. und ansonsten
Case ""
rngcell.Interior.Color = xlNone
rngcell.Font.Bold = False
rngcell.Font.Color = RGB(0, 0, 0)
End Select
Next
Set Bereich = Nothing
End If
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige