Diskussionsgruppe: Tabellenkalkulation
Hallo Ich habe folgendes Problem.
Ich habe zwei Tabellen in der einen steht in jeder Zeile ein Datensatz aus Datum Rechnungsnummer Kundennummer und Betrag (jedes in einer eigenen Zelle) in der anderen Tabelle habe ich eine Zeile in der Verwendungszweck, und Betrag stehen. Ich wurde nun gerne von einem Makro überprüfen lassen ob es übereinstimmungen gibt zwischen Tabelle 1 und 2.
Mein Problem ist dass in der Zelle Verwendungszweck mehrer Attribute wie Kundennummer, Rechnungsnummer stehen können.
Ich stelle mir das Makro wie folgt vor:
Tabelle 1
KdNr | RGNR | Betrag |
20001 | 2 | 21,25|
Tabelle 2
Verwendungszweck | Betrag|
20001 RG2| 21,25| 3 Übereinstimmungen
2 | 21,25 | 2 Übereinstimmungen
KD20001 | 21,25 | 2 Übereinstimmungen
2 KDNR 20001| 1002,21 | 2 Übereinstimmugen
Ntürlich wenn ein wert nur einmal in einer Zeile von Tabelle 2 vorkommt 1 Übereinstimmung.
Ich hoffe ihr habt meine konfusen Gedanken verstanden. Vielen Dank für die Hilfe schon mal im voraus.
Von: freysein Datum: 01.05.2007, 18:42
Antwort 1
von nighty vom 01.05.2007, 20:40
hi freysein :-)
probier das mal,nur kurz getestet :-)
gruss nighty
Option Explicit
Sub vergleich()
Dim w3x As Integer
Dim w3y As Long
Dim zaehler0 As Long
Dim zaehler1 As Integer
Dim zaehler2 As Integer
Dim suche1 As Range
Dim suche2 As Range
w3y = Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
w3x = 3
ReDim excel1(w3y, w3x) As Variant
Sheets(1).Select
excel1() = Range(Cells(1, 1), Cells(w3y, w3x))
For zaehler0 = 2 To w3y
Set suche1 = Sheets(2).Range("A1:A" & w3y).Find(excel1(zaehler0, 1), Lookat:=xlPart)
If Not suche1 Is Nothing Then
For zaehler1 = 1 To w3x
Set suche2 = Sheets(2).Range("A" & suche1.Row & ":C" & suche1.Row).Find(excel1(zaehler0, zaehler1), Lookat:=xlPart)
If Not suche2 Is Nothing Then
zaehler2 = zaehler2 + 1
End If
Next zaehler1
End If
If Not suche1 Is Nothing Then Sheets(2).Cells(suche1.Row, 4) = zaehler2
zaehler2 = 0
Next zaehler0
End Sub
Antwort 2
von nighty vom 02.05.2007, 10:47
hi freysein :-)
ups :-)
korrigiert,so müsste es funktionieren :-)))
gruss nighty
Option Explicit
Sub vergleich()
Dim w3x As Integer
Dim w3y As Long
Dim zaehler0 As Long
Dim zaehler1 As Integer
Dim zaehler2 As Integer
Dim suche1 As Range
Dim suche2 As Range
w3y = Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
w3x = 3
ReDim Excel1(w3y, w3x) As Variant
Sheets(1).Select
Excel1() = Range(Cells(1, 1), Cells(w3y, w3x))
For zaehler0 = 2 To w3y
Set suche1 = Sheets(2).Range("A1:A" & w3y).Find(Excel1(zaehler0, 1), Lookat:=xlPart)
If Not suche1 Is Nothing Then
For zaehler1 = 1 To w3x
Set suche2 = Sheets(2).Range("A" & suche1.Row & ":C" & suche1.Row).Find(Excel1(zaehler0, zaehler1), Lookat:=xlPart)
If Not suche2 Is Nothing Then
If Sheets(2).Cells(suche1.Row, zaehler1) <> Excel1(suche2.Row, zaehler1) Then
zaehler2 = zaehler2 + 1
End If
Else
zaehler2 = zaehler2 + 1
End If
Next zaehler1
End If
If Not suche1 Is Nothing Then Sheets(2).Cells(suche1.Row, 4) = zaehler2
zaehler2 = 0
Next zaehler0
End Sub
Antwort 3
von freysein vom 03.05.2007, 12:52
Dumme frage aber wie wende ich das script an? ;-)
Antwort 4
von nighty vom 03.05.2007, 12:59
hi freysein :-)
tabell1 wird mit tabelle2 verglichen,ausgehend von 3 spalten,es wird die anzahl der unstimmigkeiten in tabelle2 spalte 4 dargestellt
gruss nighty
einzufuegen
alt + f11 öffnet den projektexplorer
einfuegen/modul
da dann einfuegen
f5 ist fuer start
alternativ
extras/makro/makros
makro anwaehlen/optionen/taste zuweisen
Antwort 5
von freysein vom 03.05.2007, 16:43
Vielen Dank nightly,
aber bei mir tut sich nix, er springt zwar in tabellenblatt "Tabelle1" wenn ich mich in der "Tabelle2" befinde aber schreibt mir keine übereinstimmungen in die 4. Spalte, liegt es vielleicht daran dass ich Excel 2007 benutze?
Antwort 6
von nighty vom 04.05.2007, 09:02
hi freysein :-)
möglich,mit office2007 kenne ich mich nicht aus,das makro ist mit excel2003 entwickelt und geprüft worden,dann kann ich leider nicht weiterhelfen
gruss nighty
|
|
