VBA: Tabelle durchsuchen -> gleiche Werte der Kategorie zählen -> Statistik erst

Dieses Thema VBA: Tabelle durchsuchen -> gleiche Werte der Kategorie zählen -> Statistik erst im Forum "Microsoft Office Suite" wurde erstellt von JonnyHeart, 13. Dez. 2006.

Thema: VBA: Tabelle durchsuchen -> gleiche Werte der Kategorie zählen -> Statistik erst Hallo WinTotal-Gemeinde, ich stehe vor folgender Herausforderung: In einem Excelsheet stehen 120 Namen, die...

  1. Hallo WinTotal-Gemeinde,

    ich stehe vor folgender Herausforderung:

    In einem Excelsheet stehen 120 Namen, die jeweils in Spalte D unterschiedlichen Gruppen zugeordnet sind.

    Sheet ist wie folgt aufgebaut:
    -------------------------------------
    Spalte A: enthält in jeder Zeile eine Checkbox
    Spalte B: Name
    Spalte C: Vorname
    Spalte D: GRUPPEN (Möglichkeiten: 1 Freizeit, 2 Sport, 3 Schule, 4 Kollege)

    Nun soll per Makro Spalte D (enthält die Nummern 1,2,3 oder 4) eingelesen werden und in einer Übersicht die Anzahl der Gruppenmitglieder addiert werden.

    Ergebnis ist eine Übersicht

    ---------------------------------------------------------------
    Anzahl Mitglieder:
    --------------------------
    Gruppe 1 (Freizeit): 5
    Gruppe 2 (Sport):6
           

    Nun kommt Spalte A ins Spiel: Nur wenn in der Checkbox ein Häkchen gesetzt ist, soll der in Spalte D enthaltene Wert in der Addition berücksichtigt werden.

    :|

    Oh no...that s to much for me ..
     
  2. Hallo JonnyHeart,

    dann probier's mal damit.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Type my_Daten_struct
      zeile   As Long
      bChkBox As Boolean
      sName   As String
      sVorname As String
      lGruppe  As Long
    End Type
    
    'Spaltennummern
    Private Const cSP_CHECKBOX = 1
    Private Const cSP_NAME = 2
    Private Const cSP_VORNAME = 3
    Private Const cSP_GRUPPE = 4
    
    '*************************************************************************************
    Sub DatenMitCheckboxenSammelnUndAuswerten()
      
    '  Sheet ist wie folgt aufgebaut:
    '  -------------------------------------
    '  Spalte A: enthält in jeder Zeile eine Checkbox
    '  Spalte B: Name
    '  Spalte C: Vorname
    '  Spalte D: GRUPPEN (Möglichkeiten: 1 Freizeit, 2 Sport, 3 Schule, 4 Kollege)
    
      Dim ws As Worksheet
      Dim MyDaten() As my_Daten_struct, MyDatenCnt As Long, x As Long
      
     ->Datenfeld erstmal für 20 Einträge einrichten
      ReDim MyDaten(1 To 20)
      MyDatenCnt = 0
      
     ->aktuelle Blatt setzen
      Set ws = ActiveSheet
      
     ->Zuerst nach Zeilen mit Checkbox suchen und Zeile + Wert merken
      Call CheckboxInformationenSammeln(ws, cSP_CHECKBOX, MyDaten(), MyDatenCnt)
      
     ->weitere Daten zu den Zeilen auslesen
      For x = 1 To MyDatenCnt
        MyDaten(x).sName = ws.Cells(MyDaten(x).zeile, cSP_NAME).Value
        MyDaten(x).sVorname = ws.Cells(MyDaten(x).zeile, cSP_VORNAME).Value
        MyDaten(x).lGruppe = ws.Cells(MyDaten(x).zeile, cSP_GRUPPE).Value
      Next
      
     ->Auswertung
      Call Auswertung(ws, MyDaten(), MyDatenCnt)
      
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    
    '*************************************************************************
    Private Function Auswertung(ws As Worksheet, _
                                MyDaten() As my_Daten_struct, _
                                MyDatenCnt As Long)
                                
      Dim lAnzFreizeit As Long, lAnzSport  As Long, lAnzSchule As Long
      Dim lAnzKollege  As Long, lAnzAndere As Long, x As Long
      
      For x = 1 To MyDatenCnt
        If MyDaten(x).bChkBox Then
          Select Case MyDaten(x).lGruppe
            Case 1:     lAnzFreizeit = lAnzFreizeit + 1
            Case 2:     lAnzSport = lAnzSport + 1
            Case 3:     lAnzSchule = lAnzSchule + 1
            Case 4:     lAnzKollege = lAnzKollege + 1
            Case Else:  lAnzAndere = lAnzAndere + 1
          End Select
        End If
      Next
      
     ->Ausgabe
      
    '  ---------------------------------------------------------------
    '  Anzahl Mitglieder:
    '  --------------------------
    '  Gruppe 1 (Freizeit): 5
    '  Gruppe 2 (Sport):6
    
      MsgBox _
        --------------------------------------------------------------- & vbLf & _
        Anzahl der Mitglieder: & vbLf & _
        -------------------------- & vbLf & _
        Gruppe 1 (Freizeit):  & lAnzFreizeit & vbLf & _
        Gruppe 2 (Sport):  & lAnzSport & vbLf & _
        Gruppe 3 (Schule):  & lAnzSchule & vbLf & _
        Gruppe 4 (Kollege):  & lAnzKollege & vbLf & _
        nicht zugeordnet:  & lAnzAndere
    End Function
    
    '*************************************************************************
    Private Function CheckboxInformationenSammeln(ws As Worksheet, _
                                                  lSpalteChkBoxen As Long, _
                                                  MyDaten() As my_Daten_struct, _
                                                  MyDatenCnt As Long)
      
      Dim obj As Object
      
     ->alle OLE-Objecte
      For Each obj In ws.OLEObjects
       ->Ist Checkbox ?
        If obj.ProgId = Forms.CheckBox.1 Then
         ->ist in Spalte lSpalteChkBoxen ?
          If obj.TopLeftCell.Column = lSpalteChkBoxen Then
            MyDatenCnt = MyDatenCnt + 1
            If UBound(MyDaten()) < MyDatenCnt Then
             ->weiter 20 Einträge einrichten
              ReDim Preserve MyDaten(1 To MyDatenCnt + 19)
            End If
           ->Zeile, CheckboxWert merken
            MyDaten(MyDatenCnt).zeile = obj.TopLeftCell.Row
            MyDaten(MyDatenCnt).bChkBox = obj.Object.Value
          End If
        End If
      Next
    
    AUFRAEUMEN:
      Set obj = Nothing
    End Function
     
  3. Hi Matjes,

    vielen Dank !!!

    läuft wunderbar !!!!!!

    Gruß

    JONNY
     
Die Seite wird geladen...

VBA: Tabelle durchsuchen -> gleiche Werte der Kategorie zählen -> Statistik erst - Ähnliche Themen

Forum Datum
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Einzelne Zeilen aus Tabelle Drucken. StarOffice, OpenOffice und LibreOffice 15. März 2016
Excel 2013 SVERWEIS ergibt bei Tabellenübergreifender Nutzung 0 Microsoft Office Suite 16. Sep. 2015
Excel Tabellen erstellen mit mehreren Prüfungen Microsoft Office Suite 28. Juli 2015
Fußballtabelle Excel #NV Windows 8 Forum 1. Apr. 2015