Bestimmte Eingabe Suchen und Summierung VBA

[claudia]

Guten Morgen,

ich bräuchte mal eure Hilfe und hoffe ihr könnt mir bei meinem Problem weiterhelfen...
Ich habe eine Eingabe auf der Tabelle1 mit
Typ
Art
Anzahl

In der Tabelle2, habe ich einige Listen die in mehreren Spalten aufgelistet sind.
Problemstellung:
Die eingegebenen Daten sollen in der Tabelle2 gesucht und summiert werden. Die Bezeichnung "Art" kann aber auch zweimal in der Tabelle(Spalte) vorkommen, jedoch gibt es genau nur einen Typen dafür, wobei sich genau dieser Typ+Art von den anderen unterscheidet.

Ich hoffe ich hab es verständlich erklärt, habe auch eine Bsp.Datei im Anhang wie die Tabelle2 ca. aussieht.

LG Claudia

[Kuwer]

Hallo Claudia,

hier verwende ich die Excelfunktion VERGLEICH() = MATCH() im Code:

Code:

Sub Summieren()
  Dim iAnzahl As Long
  Dim strArt As String, strTyp As String
  Dim varCol As Variant, varRow As Variant
    
  strTyp = Tabelle1.Range("G1").Value
  strArt = Tabelle1.Range("G2").Value
  iAnzahl = Tabelle1.Range("G3").Value
  
  With Tabelle2
    varCol = Application.Match(strArt, .Rows(2), 0)
    If Not IsError(varCol) Then
      varRow = Application.Match(strTyp, .Columns(varCol - 1), 0)
      If Not IsError(varRow) Then
        .Cells(varRow, varCol + 1).Value = .Cells(varRow, varCol + 1).Value + iAnzahl
      End If
    End If
  End With
End Sub

Gruß Uwe

[claudia]

@Kuwer
WoW sehr schön, klappt auf Anhieb bei den Typen die nur einmal existieren, jedoch funktioniert der Code nicht wenn die Art_1_F mit dem TypK12 gemeint ist und nicht Art_1_F mit dem TypX15, da wird nichts summiert.

[Kuwer]

......

[schauan]

Hallo Claudia,

ist zwar ein bischen vn hinten durch die Brust ins Auge, sollte aber funktionieren. Die Arrays musst Du noch erweitern, ich hab nur mal 3 Blöcke als Beispiel definiert.

Code:

Sub Summieren()
  Dim iAnzahl As Long
  Dim strArt As String, strTyp As String
  Dim varCol As Variant, varRow As Variant
    
  Dim arrSearch, arrValues
  Dim iCnt1%
  
  strTyp = Tabelle1.Range("G1").Value
  strArt = Tabelle1.Range("G2").Value
  iAnzahl = Tabelle1.Range("G3").Value
  
  'Array mit Vergleichsspalten
  arrSearch = Array("A1:A17&B1:B17", "D1:D17&E1:E17", "M1:M17&N1:N17")
  'Array mit Datenspalten
  'Hinweis: passend zu Vergleichsspalten zusammensetzen!
  arrValues = Array("C1:C17", "F1:F17", "Q1:Q17")
  
  With Tabelle2
    'Schleife ueber Arrayeintraege
    Do
      'Wnen Zaehler groesser Anzahl Arrayeintraeg, dann Do verlassen
      If iCnt1 > UBound(arrSearch) Then Exit Do
'        varCol = Application.Match(strArt, .Rows(2), 0)
        'Eintraege "spaltenweise" vergleichen
        varCol = Application.Evaluate("=LOOKUP(2,1/(" & arrSearch(iCnt1) & "=""" & strTyp & "" & "" & strArt & """)," & arrValues(iCnt1) & ")")
      'Zaehler ochsetzen
      iCnt1 = iCnt1 + 1
    'ende Schleife ueber Arrayeintraege, wenn kein Fehlerwert in Variable
    Loop While IsError(varCol)
    
    If Not IsError(varCol) Then
      varRow = Application.Match(strTyp, .Columns(varCol - 1), 0)
      If Not IsError(varRow) Then
        .Cells(varRow, varCol + 1).Value = .Cells(varRow, varCol + 1).Value + iAnzahl
      End If
    End If
  End With
End Sub

[atilla]

Hallo,

dann habe ich noch eine Variante mit Find und FindNext:

Code:

Option Explicit

Sub summieren()

  Dim iAnzahl As Long
  Dim strArt As String, strTyp As String
  Dim rngFund As Range
  Dim strgAddress As String
  strTyp = Tabelle1.Range("G1").Value
  strArt = Tabelle1.Range("G2").Value
  iAnzahl = Tabelle1.Range("G3").Value

   With Tabelle2
      Set rngFund = .Cells.Find(what:=strTyp, _
                   lookat:=xlWhole)
      If Not rngFund Is Nothing Then
        If .Cells(rngFund.Row, rngFund.Column + 1) = strArt Then
          .Cells(rngFund.Row, rngFund.Column + 2) = .Cells(rngFund.Row, rngFund.Column + 2) + iAnzahl
        Else
          strgAddress = rngFund.Address
          Do
            If .Cells(rngFund.Row, rngFund.Column + 1) = strArt Then
              .Cells(rngFund.Row, rngFund.Column + 2) = .Cells(rngFund.Row, rngFund.Column + 2) + iAnzahl
              Exit Do
            End If
            Set rngFund = .Cells.FindNext(rngFund)
          Loop While Not rngFund Is Nothing And rngFund.Address <> strgAddress
        End If
      Else
         MsgBox "Leider nichts gefunden"
      End If
   End With
  
End Sub

[BoskoBiati]

Hallo,

ich frage mich, warum man hier nicht mit einer einfachen Formel arbeitet:

Code:

=SUMMENPRODUKT((Tabelle2!$B$1:$Q$31=G2)*(Tabelle2!$A$1:$P$31=G1);Tabelle2!C1:R31)

Summiert die dritte Spalte, wenn die ersten beiden übereinstimmen.

Code:

=SUMMENPRODUKT((Tabelle2!$B$1:$Q$31=G2)*(Tabelle2!$A$1:$P$31=G1)*(Tabelle2!$C$1:$R$31=G3))
=ZÄHLENWENNS(Tabelle2!$B$1:$Q$31;G2;Tabelle2!$A$1:$P$31;G1;Tabelle2!$C$1:$R$31;G3)

Zählt alle Eintragungen, in denen alle drei Bedingungen übereinstimmen.

Als VBA-Code

Code:

Sub test()
Range("H3")=application.worksheetfunction.countifs(sheets("Tabelle2").Range("B1:Q31"),Range("G2"),sheets("Tabelle2").Range("A1:P31"),Range("G1"),sheets("Tabelle2").Range("C1:R31"),Range("G3"))
end sub

[schauan]

Hallo Edgar,
Du hast aber im Beispiel 5 oder 6 Bereiche, die Du prüfen musst... Und vielleicht werden es noch mehr. Wenn Du die Lookup - Formel nimmst, ist die vielleicht etwas kürzer.

[Kuwer]

Hallo Claudia,

hier auch noch meine Version für beliebig viele Spalten:

Code:

Sub Summieren()
  Dim iAnzahl As Long, iErsteSpalte As Long, iLetzteSpalte As Long
  Dim strArt As String, strTyp As String
  Dim varCol As Variant, varRow As Variant
  
  strTyp = Tabelle1.Range("G1").Value
  strArt = Tabelle1.Range("G2").Value
  iAnzahl = Tabelle1.Range("G3").Value
  
  With Tabelle2
    iLetzteSpalte = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Do
      iErsteSpalte = varCol + 1
      If iErsteSpalte < iLetzteSpalte Then
        With .Range(.Cells(2, iErsteSpalte), .Cells(2, iLetzteSpalte))
          varCol = .Columns(Application.Match(strArt, .Cells, 0)).Column
        End With
        'Debug.Print iErsteSpalte & " : " & varCol & " : " & .Range(.Cells(2, iErsteSpalte), .Cells(2, iLetzteSpalte)).Address(0, 0)
        If Not IsError(varCol) Then
          varRow = Application.Match(strTyp, .Columns(varCol - 1), 0)
          If Not IsError(varRow) Then
            .Cells(varRow, varCol + 1).Value = .Cells(varRow, varCol + 1).Value + iAnzahl
            MsgBox "Die Zelle Tabelle2!" & .Cells(varRow, varCol + 1).Address(0, 0) & _
                   " wurde auf " & .Cells(varRow, varCol + 1).Value & " erhöht."
            Exit Do
          End If
        Else
          MsgBox "Kombination wurde nicht gefunden!"
          Exit Do
        End If
      Else
        MsgBox "Kombination wurde nicht gefunden!"
        Exit Do
      End If
    Loop
  End With
End Sub

Gruß Uwe

[BoskoBiati]

Hallo André,

solange die Anordnung immer die Gleiche ist, Typ/Art/Anzahl, ist es unerheblich ob das 6,15 oder 30 Spalten sind. Ich frage mich eher, warum hier eine Summe gebildet werden soll, wenn die Kombination nur einmal vorkommt.