Vergleichen mit zwei Variablen

Hallo,
ich habe folgende Anforderung:
in Tabelle 1 habe ich eine Liste mit Vertragsnummern, dazu gehörende Produkte und spezielle Preise.
In Tabelle 2 habe ich eine Liste mit Vertragsnummern und Stückzahlen welches Produkt aus dem jeweiligen Vertrag wie oft verkauft wurde.
Das Problem ist das die Sortierung nicht zusammenpasst da auf jeder Vertragsnummer unterschiedlich viele Produkte hinterlegt sind und in Tabelle 2 nur die Produkte aufgeführt sind bei denen mindestens 1STK verkauft wurde.
Ziel ist die Verkaufte Menge je Produkt pro Vertragsnummer in Tabelle 1 einzufügen.
Also ungefähr so:
WENN "Vertragsnummer T1" = "Vertragsnummer T2" UND "Produkt T1" = "Produkt T2" DANN "Verkaufte Menge"
ich hoffe man kann das halbwegs verstehen. Ich habe es mit der Verschachtelung von WENN und SVERWEIS Funktionen versucht, leider erfolglos. Vielleicht hat ja jemand einen Tip.
Vielen Dank im Voraus!
lg
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
einfach auf dem Button drücken in Tabelle1: https://www.herber.de/bbs/user/117387.xlsm
Hier ein viel zu umständlicher Code:
(Ich gestehe ich bin ein wenig entäuscht von mir selbst)

Option Explicit
Public Sub Order_()
Dim tmp(), varItem As Variant
Dim lRow, i As Long
Dim ws As Worksheet
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Sheets("Tabelle2")
With ws
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
tmp = .Range(.Cells(2, 1), .Cells(lRow, 3)).Value2
For i = 1 To UBound(tmp)
If Not dict.Exists(tmp(i, 1)) Then
dict.Add tmp(i, 1), tmp(i, 2) & ";" & tmp(i, 3)
Else
varItem = dict(tmp(i, 1))
varItem = varItem & "," & tmp(i, 2) & ";" & tmp(i, 3)
dict(tmp(i, 1)) = varItem
End If
Next i
End With
Arrange_ dict
Erase tmp
Set dict = Nothing
Set ws = Nothing
End Sub
Private Sub Arrange_(ByVal dict As Object)
Dim ws As Worksheet
Dim lRow, i, ii As Long
Dim split_1, split_2() As String
Dim varItem, tmp As Variant
Set ws = ThisWorkbook.Sheets("Tabelle1")
With ws
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lRow
tmp = .Cells(i, 1).Value
If dict.Exists(tmp) Then
split_1 = Split(dict(tmp), ",")
For Each varItem In split_1
split_2 = Split(varItem, ";")
ii = IndexOf(split_2, .Cells(i, 2))
If ii > 0 Then
.Cells(i, 4).Value = split_2(ii)
End If
Erase split_2
Next varItem
Erase split_1
End If
Next i
End With
Set dict = Nothing
Set ws = Nothing
End Sub
Private Function IndexOf(ByRef array_ As Variant, ByVal this_ As Variant) As Long
With Application
If Not VBA.IsError(.Match(this_, array_, 0)) Then
IndexOf = .Match(this_, array_, 0)
End If
End With
End Function

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread