HERBERS Excel-Forum - die Beispiele

Thema: Beispiel für die Anwendung der SUMMEWENN-FORMEL

Home

Gruppe

Funktion

Problem

Wie ist die SUMMEWENN-Formel zu handhaben?

Lösung
Die Formel: =SUMMEWENN(A:A;D2;B:B)
ClassModule: Tabelle1

Private Sub Worksheet_Activate()
   Dim oBtn As CommandBarButton
   With Application.CommandBars("Cell")
      Set oBtn = .FindControl(ID:=21)
      oBtn.Enabled = False
   End With
End Sub

Private Sub Worksheet_Deactivate()
   Application.CommandBars("Cell").Reset
End Sub

StandardModule: Modul1

Sub ReadID()
   Dim sMsg As String
   sMsg = "Erstes Element im Zell-Kontextmenü:" & vbLf
   With Application.CommandBars("Cell").Controls(1)
      sMsg = sMsg & "Caption: " & .Caption & vbLf
      sMsg = sMsg & "ID: " & .ID
      MsgBox sMsg
   End With
End Sub

Sub ShowPosition()
   Dim iLeft As Integer, iTop As Integer
   iLeft = Application.InputBox("Linke Position:", , 200, Type:=1)
   iTop = Application.InputBox("Obere Position:", , 200, Type:=1)
   Application.CommandBars("Cell").ShowPopup iLeft, iTop
End Sub

Sub MonthMessage()
   MsgBox "Aufruf kam von " & _
      Application.CommandBars("Months") _
      .Controls(Application.Caller(1)).Caption
End Sub

Sub SetFilter()
   Dim iRow As Integer
   Application.ScreenUpdating = False
   Rows.Hidden = False
   iRow = 1
   Do Until IsEmpty(Cells(iRow, 1))
      If Weekday(Cells(iRow, 1).Value) <> Application.Caller(1) - 2 Then
         Rows(iRow).Hidden = True
      End If
      iRow = iRow + 1
   Loop
   Application.ScreenUpdating = True
End Sub

Sub ResetFilter()
   Rows.Hidden = False
End Sub

Sub SpaltenAus()
   Selection.EntireColumn.Hidden = True
End Sub

Sub SpaltenEin()
   Selection.EntireColumn.Hidden = False
End Sub

Sub InsertValue()
   ActiveCell.Value = Application.CommandBars("RowValues") _
      .Controls(Application.Caller(1)).Caption
End Sub

Sub SelectSheet()
   Worksheets(Application.CommandBars("SheetSelect") _
      .Controls(Application.Caller(1)).Caption).Select
End Sub

Sub DialogShortCutMenus()
   frmKontext.Show
End Sub

Sub ListShortCutMenus()
   Dim oBar As CommandBar
   Dim oCntr As CommandBarControl
   Dim iRow As Integer
   Application.ScreenUpdating = False
   Workbooks.Add
   Range("A1").Value = "Name"
   Range("B1").Value = "Lokaler Name"
   Range("C1").Value = "Eingebaut"
   Range("D1").Value = "Schaltflächen"
   Range("E1").Value = "ID"
   Rows(1).Font.Bold = True
   iRow = 1
   For Each oBar In Application.CommandBars
      If oBar.Type = msoBarTypePopup Then
         iRow = iRow + 1
         Cells(iRow, 1) = oBar.Name
         Cells(iRow, 2) = oBar.NameLocal
         Cells(iRow, 3) = oBar.BuiltIn
         For Each oCntr In oBar.Controls
            Cells(iRow, 4) = oCntr.Caption
            Cells(iRow, 5) = oCntr.ID
            iRow = iRow + 1
         Next oCntr
      End If
   Next oBar
   Columns.AutoFit
   Application.ScreenUpdating = False
End Sub
ClassModule: frmKontext

Private Sub cboControl_Change()
   If cboControl.Text = "" Then Exit Sub
   lblIndexControl.Caption = _
      Application.CommandBars(cboKontext.Text) _
      .Controls(cboControl.Text).ID
End Sub

Private Sub cboKontext_Change()
   Dim objBar As CommandBar
   Dim objCntr As CommandBarControl
   Set objBar = Application.CommandBars(cboKontext.Text)
   lblIndexMenu.Caption = objBar.Index
   lblNameLocal.Caption = objBar.NameLocal
   cboControl.Clear
   For Each objCntr In objBar.Controls
      cboControl.AddItem objCntr.Caption
   Next objCntr
   cboControl.ListIndex = 0
End Sub

Private Sub cmdCancel_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
   Unload Me
   Call ListShortCutMenus
End Sub

Private Sub UserForm_Initialize()
   Dim objBar As CommandBar
   For Each objBar In CommandBars
      If objBar.Type = msoBarTypePopup Then
         cboKontext.AddItem objBar.Name
      End If
   Next objBar
   cboKontext.ListIndex = 0
End Sub
ClassModule: Tabelle3

Private Sub Worksheet_BeforeRightClick( _
   ByVal Target As Range, Cancel As Boolean)
   If Not Intersect( _
      Target, Range("A1:F16")) Is Nothing Then
      Cancel = True
   End If
End Sub

ClassModule: Tabelle4

Private Sub Worksheet_Activate()
   Dim oBar As CommandBar
   Dim oBtn As CommandBarButton
   Dim iCounter As Integer
   On Error Resume Next
   Application.CommandBars("Months").Delete
   On Error GoTo 0
   Set oBar = Application.CommandBars.Add( _
      "Months", msoBarPopup, False, True)
   For iCounter = 1 To 12
      Set oBtn = oBar.Controls.Add
      With oBtn
         .Caption = Format( _
            DateSerial(1, iCounter, 1), "mmmm")
         .Style = msoButtonCaption
         .OnAction = "MonthMessage"
      End With
   Next iCounter
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("Months").Delete
   On Error GoTo 0
End Sub

Private Sub Worksheet_BeforeRightClick( _
   ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   Application.CommandBars("Months").ShowPopup
End Sub

ClassModule: Tabelle5

Private Sub Worksheet_Activate()
   Dim oBar As CommandBar
   Dim oBtn As CommandBarButton
   Dim iCounter As Integer
   On Error Resume Next
   Application.CommandBars("Days").Delete
   On Error GoTo 0
   Set oBar = Application.CommandBars.Add( _
      "Days", msoBarPopup, False, True)
   Set oBtn = oBar.Controls.Add
   With oBtn
      .Caption = "Wochentage:"
      .Style = msoButtonCaption
   End With
   For iCounter = 1 To 7
      Set oBtn = oBar.Controls.Add
      With oBtn
         .Caption = Cells(5 + iCounter, 1).Text
         .Style = msoButtonCaption
         .OnAction = "SetFilter"
         If iCounter = 1 Then
            .BeginGroup = True
         End If
      End With
   Next iCounter
   Set oBtn = oBar.Controls.Add
   With oBtn
      .Caption = "Zurücksetzen"
      .Style = msoButtonCaption
      .OnAction = "ResetFilter"
      .BeginGroup = True
   End With
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("Days").Delete
   On Error GoTo 0
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   Application.CommandBars("Days").ShowPopup
End Sub

ClassModule: Tabelle6

Private Sub Worksheet_Activate()
   Dim oBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oCntr As CommandBarControl
   Dim oBtn As CommandBarButton
   On Error Resume Next
   Application.CommandBars("KonNames").Delete
   On Error GoTo 0
   Set oBar = Application.CommandBars.Add( _
      "KonNames", msoBarPopup, False, True)
   Set oPopUp = Application.CommandBars.FindControl(ID:=30023)
   For Each oCntr In oPopUp.Controls
      Set oBtn = oBar.Controls.Add(ID:=oCntr.ID)
   Next oCntr
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("KonNames").Delete
   On Error GoTo 0
End Sub

Private Sub Worksheet_BeforeRightClick( _
   ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   Application.CommandBars("KonNames").ShowPopup
End Sub
ClassModule: Tabelle7

Private Sub Worksheet_Activate()
   Dim oBtn As CommandBarButton
   With Application.CommandBars("Cell")
      On Error Resume Next
      .Controls("Spalten aus").Delete
      .Controls("Spalten ein").Delete
      On Error GoTo 0
      Set oBtn = .Controls.Add
      oBtn.Caption = "Spalten aus"
      oBtn.Style = msoButtonCaption
      oBtn.OnAction = "SpaltenAus"
      oBtn.BeginGroup = True
      Set oBtn = .Controls.Add
      oBtn.Caption = "Spalten ein"
      oBtn.Style = msoButtonCaption
      oBtn.OnAction = "SpaltenEin"
   End With
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   With Application.CommandBars("Cell")
      .Controls("Spalten aus").Delete
      .Controls("Spalten ein").Delete
   End With
   On Error GoTo 0
End Sub

ClassModule: Tabelle8

Private Sub Worksheet_Activate()
   Dim oPopUp As CommandBarControl
   Dim oBtn As CommandBarButton
   On Error Resume Next
   Application.CommandBars("Cell") _
      .Controls("Spalten").Delete
   On Error GoTo 0
   Set oPopUp = Application.CommandBars( _
      "Cell").Controls.Add(msoControlPopup)
   With oPopUp
      .Caption = "Spalten"
      .BeginGroup = True
   End With
   Set oBtn = oPopUp.Controls.Add
   With oBtn
      .Caption = "Spalten aus"
      .Style = msoButtonCaption
      .OnAction = "SpaltenAus"
   End With
   Set oBtn = oPopUp.Controls.Add
   With oBtn
      .Caption = "Spalten ein"
      .Style = msoButtonCaption
      .OnAction = "SpaltenEin"
   End With
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("Cell") _
      .Controls("Spalten").Delete
   On Error GoTo 0
End Sub

ClassModule: Tabelle9

Private Sub Worksheet_BeforeRightClick( _
   ByVal Target As Range, Cancel As Boolean)
   Dim oBar As CommandBar
   Dim oBtn As CommandBarButton
   Dim iCol As Integer
   If WorksheetFunction.CountA( _
      Range(Cells(Target.Row, 3), _
      Cells(Target.Row, 256))) = 0 Then Exit Sub
   Cancel = True
   On Error Resume Next
   Application.CommandBars("RowValues").Delete
   On Error GoTo 0
   Set oBar = Application.CommandBars.Add( _
      "RowValues", msoBarPopup)
   For iCol = 3 To 256
      If Not IsEmpty(Cells(Target.Row, iCol)) Then
         Set oBtn = oBar.Controls.Add
         With oBtn
            .Caption = Cells(Target.Row, iCol).Value
            .Style = msoButtonCaption
            .OnAction = "InsertValue"
         End With
      End If
   Next iCol
   Application.CommandBars("RowValues").ShowPopup
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("RowValues").Delete
   On Error GoTo 0
End Sub
ClassModule: Tabelle10

Private Sub Worksheet_BeforeRightClick( _
   ByVal Target As Range, Cancel As Boolean)
   Dim oBar As CommandBar
   Dim oBtn As CommandBarButton
   Dim wks As Worksheet
   Cancel = True
   On Error Resume Next
   Application.CommandBars("SheetSelect").Delete
   On Error GoTo 0
   Set oBar = Application.CommandBars.Add( _
      "SheetSelect", msoBarPopup)
   For Each wks In Worksheets
      If wks.Index <> Me.Index Then
         Set oBtn = oBar.Controls.Add
         With oBtn
            .Caption = wks.Name
            .Style = msoButtonCaption
            .OnAction = "SelectSheet"
         End With
      End If
   Next wks
   Application.CommandBars("SheetSelect").ShowPopup
End Sub

Private Sub Worksheet_Deactivate()
   On Error Resume Next
   Application.CommandBars("SheetSelect").Delete
   On Error GoTo 0
End Sub

Beiträge aus dem Excel-Forum zu den Themen Funktion und SUMMEWENN

Copy funktioniert nur einmal Schreibschutz prüfen funktioniert nicht
Split-Funktion beim Einlesen TXT-Datei Match Funktion spinnt (?)
summewenn verbessern SVerweis funktioniert nicht
PasteSpecial funktioniert nicht. VBA-Code funktioniert nicht mit anderem Office
Hilfe bei der INDEX Funktion Zelladressen von FunktionsParametern ermitteln
Matrixformel mit Summenfunktion SUMMEWENN über mehrere
Formel funktioniert nicht, SVerweis Summewenn mit Bezug auf ein Datum
Makro funktioniert nach Beenden von Excel nicht VLOOKUP auf Links funktioniert offline
@DAVID Zwei SUMMEWENN funktionen verknüpfen Zwei SUMMEWENN funktionen verknüpfen
Polynomfunktion Summewenn mit meheren Kriterien/Blaettern
Mit vba Funktionen in Excel Zellen Filtern oder Summewenn !?
Rang-Funktion für Strings? Summewenn/Summenprodukt mit mehreren Kriterien
Skript funktioniert nur auf einer seite?!?! Hyperlink auf Excel-Datei funktioniert nicht
Public Funktion / Variabel VBA - Suchfunktion - Fehlermeldung
Benutzerdefinierte Funktion Summewenn = Zählenwenn (bei 0)
Userform mit Löschfunktion Summewenn mit abhängigen Bereichen
Summewenn mit abhängigen Bereichen Frage zu summeWenn
Frage zu Wenn Dann Funktion Wenn-Funktion
SUMMEWENN auf verschiedene Spalten Frage zur Funktion DISAGIO
summewenn mit Zelle als Suchkriterium Funktion um Chart zu kreieren
Wenn-Funktion verschachtelt VBA Suchfunktion erweitern
Makro funktioniert nicht richtig zählenwenn-funktion mit mehreren kriterien
SummeWenn Funktion SVERWEIS
Benutzerdefinierte Funktion in Open Office Funktion Dezimal -> Zeit/ Variablen-Deklaration
Probleme mit Textfunktionen Fehler, wenn Variable in Funktion