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

Code ändern

Code ändern
26.03.2015 16:50:16
Dieter
Hallo Forum
Beispieldatei:
https://www.herber.de/bbs/user/96659.xlsm
Ich habe Folgenden Code:
Private Sub CommandButton1_Click()
Call prcFaerben(ButtonNr:=1)
End Sub
Private Sub CommandButton2_Click()
Call prcFaerben(ButtonNr:=2)
End Sub
Sub prcFaerben(ButtonNr As Integer)
Dim wks As Worksheet
Dim Zeile_Aktuell As Long
Dim Zeile_1 As Long
Dim SpalteSumme As Long, Spalte_letzte As Long
Dim Farbe As Long, Farbevorher As Long
Const lngColorIndex_1 As Long = 37
Const lngColorIndex_2 As Long = 40
'Farbwerte setzen abhängig von der Button-Nr.
Select Case ButtonNr
Case 1
Farbe = lngColorIndex_1
Farbevorher = lngColorIndex_2
Case 2
Farbe = lngColorIndex_2
Farbevorher = lngColorIndex_1
End Select
Set wks = ActiveSheet
Application.ScreenUpdating = False
Zeile_Aktuell = ActiveCell.Row
Zeile_1 = Zeile_Aktuell
With wks
If wks.Cells(Zeile_Aktuell, 1).Value = "" Then
MsgBox "Makro nur starten, wenn Spalte A in aktiver Zeile ausgefüllt ist."
Exit Sub
End If
'Zeile oberhalb suchen mit Farbevorher
Do
If Zeile_1 = 1 Then Exit Do
If .Cells(Zeile_1, 1).Interior.ColorIndex = Farbevorher Then
Zeile_1 = Zeile_1 + 1
Exit Do
End If
Zeile_1 = Zeile_1 - 1
Loop
'Letzte Spalte in Zeile mit aktiver Zelle suchen
If .Cells(Zeile_Aktuell, 11) "" Then
Spalte_letzte = 11
Else
Spalte_letzte = .Cells(Zeile_Aktuell, 11).End(xlToLeft).Column
End If
'färben
.Range(.Cells(Zeile_1, 1), .Cells(Zeile_Aktuell, 1)).Interior.ColorIndex = Farbe
.Range(.Cells(Zeile_1, 3), .Cells(Zeile_Aktuell, Spalte_letzte)).Interior.ColorIndex = _
Farbe
'******************************************
' Code hier verändern
'******************************************
'Summe über den jeweils gefärbten Bereich ab Spalte 3
' .Cells(30, 3) = Application.WorksheetFunction.Sum _
(.Range(.Cells(Zeile_1, 3), .Cells(Zeile_Aktuell, Spalte_letzte)))
'*******************************************
'*******************************************
End With
Application.ScreenUpdating = True
End Sub
Kann mir jemand helfen, denn Code so zu verändern, dass nicht die Gesammte Summe des Bereiches berechnet wird, sondern nur der Bereich für die Einzelne Spalten?
das Heißt in Cells(30,3) soll dann die Summe für Spalte "C" stehen, in Cells(30,4) soll die Summe für Spalte "D" stehen usw usw
Hoffe, dass das nicht zu undeutlich ist und ihr micht versteht
danke schon einmal im Vorraus
Dieter
Original Code von "Fcs"
https://www.herber.de/forum/archiv/1416to1420/t1416247.htm

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code ändern
01.04.2015 10:08:25
fcs
Hallo Dieter,
hier das Färbenmakro mit denn notwendigen Anpassungen.
Gruß
Franz
Sub prcFaerben(ButtonNr As Integer)
Dim wks As Worksheet
Dim Zeile_Aktuell As Long
Dim Zeile_1 As Long
Dim SpalteSumme As Long, Spalte_letzte As Long
Dim Spalte As Long, Spalte_L_max As Long                'neu 2015-04-01
Dim Farbe As Long, Farbevorher As Long
Const lngColorIndex_1 As Long = 37
Const lngColorIndex_2 As Long = 40
'Farbwerte setzen abhängig von der Button-Nr.
Select Case ButtonNr
Case 1
Farbe = lngColorIndex_1
Farbevorher = lngColorIndex_2
Case 2
Farbe = lngColorIndex_2
Farbevorher = lngColorIndex_1
End Select
Set wks = ActiveSheet
Application.ScreenUpdating = False
Zeile_Aktuell = Cells(1, 1).End(xlDown).Row
Zeile_1 = Zeile_Aktuell
With wks
If wks.Cells(Zeile_Aktuell, 1).Value = "" Then
MsgBox "Makro nur starten, wenn Spalte A in aktiver " _
& "Zeile ausgefüllt ist."
Exit Sub
End If
'Zeile oberhalb suchen mit Farbevorher
Do
If Zeile_1 = 1 Then Exit Do
If .Cells(Zeile_1, 1).Interior.ColorIndex = Farbevorher Then
Zeile_1 = Zeile_1 + 1
Exit Do
End If
Zeile_1 = Zeile_1 - 1
Loop
'Letzte Spalte in Zeile mit aktiver Zelle suchen
If .Cells(Zeile_Aktuell, 11)  "" Then
Spalte_letzte = 11
Else
Spalte_letzte = .Cells(Zeile_Aktuell, 11).End(xlToLeft).Column
End If
If Spalte_L_max 

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige