Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Gesamtstatusabfrage

Betrifft: VBA Gesamtstatusabfrage von: LaFu LaFu
Geschrieben am: 01.09.2020 18:49:19

Guten Abend,

https://www.herber.de/bbs/user/139977.xlsm

ich möchte gern in dem Workbook den Gesamtstatus (A1) abrufen, welcher nach Auswahl der jeweiligen Einzelstatus entweder "Erledigt" (nur wenn auch wirklich alle Einzelstatus auf Erledigt stehen) oder "Offen" (nur wenn auch wirklich alle Einzelstatus auf Offen stehen) anzeigen soll.

Ich habe mich auch schon mal an einem Code probiert, wobei die Betonung leider auf probiert liegt.

Außerdem frage ich mich, ob es möglich ist, eine Range nicht fix (Range("A3:A15") anzugeben sondern variabel je nach Anzahl der Einzelstatus (irgendwie mit xlDown?). Habe dies in der VBA der Excel gekennzeichnet.

Freue mich auf nette und hilfreiche Antworten.

Grüße
LaFu

Betrifft: AW: VBA Gesamtstatusabfrage
von: Marc
Geschrieben am: 01.09.2020 19:08:14

Bitteschön,

ganz ohne Makro. Ist eh viel besser in Excel ;)

https://www.herber.de/bbs/user/139978.xlsm

Gruß Marc

Betrifft: AW: VBA Gesamtstatusabfrage
von: AlterDresdner
Geschrieben am: 01.09.2020 19:31:57

Hallo,
die Formellösung bringt mit
=WENN(ZÄHLENWENN(A3:A1048576;"*")=ZÄHLENWENN(A3:A1048576;"Offen");"Offen"; WENN(ZÄHLENWENN(A3:A1048576;"*")=ZÄHLENWENN(A3:A1048576;"Erledigt");"Erledigt";"Gemischt"))
das gleiche Ergebnis.
Der AlteDresdner

Betrifft: AW: VBA Gesamtstatusabfrage
von: LaFu LaFu
Geschrieben am: 01.09.2020 19:50:25

An beide, vielen Dank! Ich verwende vermutlich Marc's Formel, weil diese schön kurz ist und ihren Zweck erfüllt und mich ärgert, da ich nicht auf sie gekommen bin.
Das Makro erfüllt einen Lernzweck für mich, auch dafür Danke!

Betrifft: AW: VBA Gesamtstatusabfrage
von: AlterDresdner
Geschrieben am: 01.09.2020 19:19:31

Hallo Lafu,
das Makro sollte so aussehen:
Sub Aufgabenstatus()
    Dim rngBereich As Range, rngZelle As Range, lastrow As Long
    Dim IsErl As Long, IsOff As Long 'Anzahlen von Offen/Erledigt
    With ActiveSheet
      lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
      Set rngBereich = .Range("A3:A" & lastrow)
      For Each rngZelle In rngBereich
          If rngZelle.Value = "Offen" Then IsOff = IsOff + 1
          If rngZelle.Value = "Erledigt" Then IsErl = IsErl + 1
      Next
      If IsOff = lastrow - 2 Then
        .Range("A1") = "Offen"
      ElseIf IsErl = lastrow - 2 Then
        .Range("A1") = "Erledigt"
      Else
        .Range("A1") = "Gemischt"
      End If
    End With
End Sub

Um es auszulösen, in den Codeteil des Blattes noch einfügen
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And Target.Row > 2 Then Aufgabenstatus
End Sub

Gruß der AlteDresdner