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.
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 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28 • claudia
17.02.2015, 12:51 (Dieser Beitrag wurde zuletzt bearbeitet: 17.02.2015, 12:56 von 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.
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
'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-2019+365)
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
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.
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-2019+365)
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
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
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.