VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 11:18:48	Ekwah
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 16:44:57	Mackie
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 18:48:23	Gast70117
PS	13.09.2017 18:55:23	Gast70117

Ansicht des Beitrags:

Von:
Gast70117

Datum:
13.09.2017 18:48:23

Views:
596

Rating:

Antwort:

Thema:
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen

Option Explicit

Sub DoTwice()

'.Interior.ColorIndex = 36 vs. .Interior.ColorIndex = 44

Const C_REL As String = "=SUM(R[-WERT]C:R[-1]C)"

Dim rngU As Range, rngCol As Range
Dim lngRow As Long, lngHitCol As Long
Dim lngBeg As Long, lngEnd As Long
Dim strAddr As String
Dim flag As Boolean

   'define the range
   lngBeg = 1: lngEnd = 1
   Set rngU = ActiveSheet.UsedRange
   Set rngU = rngU.Offset(1).Resize(rngU.Rows.Count - 1)
   Set rngU = Intersect(rngU, Columns("H:BD"))
   ' iterate each column
   For Each rngCol In rngU.Columns
      lngBeg = 0: lngEnd = 0: strAddr = ""
      ' iterate each row
      For lngRow = 1 To rngCol.Cells.Count
         ' search for any color in the row of the rngU
         lngHitCol = rngCol.Cells(lngRow).DisplayFormat.Interior.ColorIndex '  <> -4142 Then
         If lngHitCol = 44 Then flag = True
         Select Case lngHitCol
            Case 36
               lngEnd = lngRow
                If Not flag Then
                  rngCol.Cells(lngRow).FormulaR1C1 = Replace(C_REL, "WERT", Format(lngEnd - lngBeg, "#"))
                  lngBeg = lngEnd + 1
               Else
                  lngBeg = lngBeg + 1
                  rngCol.Cells(lngRow).FormulaR1C1 = Replace(C_REL, "WERT", Format(lngEnd - lngBeg, "#"))
                  lngBeg = lngEnd + 1
                  flag = False
               End If
               strAddr = strAddr & "+" & rngCol.Cells(lngRow).Address(0, 0)
            Case 44
                strAddr = Mid(strAddr, 2)
                rngCol.Cells(lngRow).Formula = "=" & strAddr
               strAddr = ""
         End Select
      Next lngRow
   Next rngCol

End Sub

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 11:18:48	Ekwah
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 16:44:57	Mackie
Makro-Erstellung, um in die orangenen Zeilen eine Summenformel einzufügen	13.09.2017 18:48:23	Gast70117
PS	13.09.2017 18:55:23	Gast70117