Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Bestimmte Eingabe Suchen und Summierung VBA
#1
Guten Morgen,

ich bräuchte mal eure Hilfe und hoffe ihr könnt mir bei meinem Problem weiterhelfen...Blush
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


Angehängte Dateien
.xlsm   Mappe1_Summe.xlsm (Größe: 23,77 KB / Downloads: 17)
to top
#2
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
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
claudia
to top
#3
@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. UndecidedUndecided
to top
#4
......
to top
#5
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
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#6
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
Gruß Atilla

Excel 2007
to top
#7
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
Gruß


Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
to top
#8
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.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#9
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
to top
#10
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.
Gruß


Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Automatisierung durch Eingabe Tekxtase 1 89 21.10.2016, 20:25
Letzter Beitrag: schauan
  bei falscher Zellen eingabe, Zelle beibehalten schrotti1962 2 127 01.10.2016, 11:22
Letzter Beitrag: RPP63
  Zelle mit Auswahlmenü bedingt durch eine andere Eingabe stbelgien 5 271 21.09.2016, 14:05
Letzter Beitrag: Rabe
  Formel verschwindet während Eingabe Manfred_Grabowski 2 163 19.08.2016, 10:59
Letzter Beitrag: WillWissen
  Summierung Runner 9 266 18.08.2016, 08:10
Letzter Beitrag: Luffy
  Aktuellsten Wert unter Eingabe von Kriterien heraussuchen Julia_a 10 457 08.08.2016, 16:56
Letzter Beitrag: Julia_a
  Zeile teilweise grau markieren bei Eingabe eines bestimmten Wertes Woelfi22 3 160 19.07.2016, 08:36
Letzter Beitrag: chris-ka
  Vergleich einer Zahl durch Summierung div. anderer Zahlen/Möglichkeiten Maik 0 152 12.07.2016, 13:59
Letzter Beitrag: Maik
  Datenüberprüfung ohne Eingabe derhilde 1 187 07.07.2016, 13:17
Letzter Beitrag: steve1da
Photo Arbeitszeit Eingabe farblicher Zeitstrahl automatisch lordi 11 963 05.05.2016, 20:02
Letzter Beitrag: Jockel

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste