Thema Datum  Von Nutzer Rating
Antwort
19.02.2021 12:41:55 Christian Reichelt
NotSolved
19.02.2021 13:09:53 Mase
NotSolved
19.02.2021 14:22:22 Christian Reichelt
NotSolved
Blau Mittelwertbildung für einzelne Bereiche
 19.02.2021 16:39:45 Mase
Solved
19.02.2021 16:58:11 Christian Reichelt
NotSolved

Ansicht des Beitrags:
Von:
Mase		 Datum:
19.02.2021 16:39:45		 Views:
614		 Rating:
     
Antwort:
 Nein
Thema:
Mittelwertbildung für einzelne Bereiche

Der Code orientiert sich nicht an Deiner Produktivliste, sondern an die gezeigte Liste aus Beitrag eins.

Option Explicit

Sub QuickAndDirtyButWithComments()

    Dim rng         As Excel.Range
    Dim rngAreas    As Excel.Range
    Dim i           As Long
    
    With ActiveSheet
        '*** Wenn Autofilter vorhanden, dann entfernen
        If .AutoFilterMode Then .AutoFilterMode = False
        '*** Autofilterbereich ermitteln; linke obere Ecke A1 bis zu rechte untere Ecke in Spalte B
        Set rng = .Range("A1", .Cells(.Rows.Count, "B").End(xlUp))
    End With
    
    '*** Filter setzen
    rng.AutoFilter Field:=2, Criteria1:="JA"
    
    '*** Schnittmenge setzen (falls vorhanden)
    Set rngAreas = Application.Intersect(rng, rng.Offset(1), rng.SpecialCells(xlCellTypeVisible))
    
    '*** Wenn Schnittmenge vorhanden
    If Not rngAreas Is Nothing Then
        '*** Loope durch die Areas
        For i = 1 To rngAreas.Areas.Count Step 1
            '*** Schreibe pro Area in Zelle "BC+Schleifenzähler"
            ActiveSheet.Range("BC" & i).Value = Application.WorksheetFunction.Average(rngAreas.Areas(i).Cells)
        Next i
    End If
 
    '*** Filter wieder entfernen
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    
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
19.02.2021 12:41:55 Christian Reichelt
NotSolved
19.02.2021 13:09:53 Mase
NotSolved
19.02.2021 14:22:22 Christian Reichelt
NotSolved
Blau Mittelwertbildung für einzelne Bereiche
 19.02.2021 16:39:45 Mase
Solved
19.02.2021 16:58:11 Christian Reichelt
NotSolved