Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
308to312
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
308to312
308to312
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spaltenvergleich mit 3 Bedingungen und Kopie

Spaltenvergleich mit 3 Bedingungen und Kopie
18.09.2003 14:28:02
Thorsten
Hi,

habe ein sehr komplizierte Aufgabe zu lösen und komme da ohne Hilfe nicht weiter. Ich habe folgende Situation:






In der Tabelle 1 (entspricht dem Worksheet 1) stehen meine Ausgangsdaten.
In Spalte A steht die Postionsnummer, in der Splate C mein Wert (Zahlen+ Buchstaben) mir dazugehörigen Datum. Was nun geschehen soll ist folgendes: Die Werte aus C und D der Tabelle 1 sollen mit den Werten aus F und I der Tabelle 2 (Worksheet 2) verglichen werden. Stimmen die Daten überein, soll die entsprechende gesamte Zeile aus Tabelle 2 kopiert werden und auf Tabellenblatt 3 eingefügt werden. Dabei soll allerdings dann in der ersten Spalte die zugehörige Positionsnummer aus Tabelle 1 mit übernommen werden, um so den Bezug aus Tabelle 1 feststellen zu können.
Abschließend soll noch, in Abhängigkeit von der Spalte H der Tabelle 1 bei der Kopie in Tabelle 3 die Interior color der Zellen festgelgt werden, so das bei "ja" die Farbe grün ist und bei "nein" die Farbe rot.

Da ich nicht weiß, wie ich eine solche komplexe Aufgabe lösen könnte, wäre ich für jede Hilfe sehr dankbar.

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenvergleich mit 3 Bedingungen und Kopie
18.09.2003 16:02:58
Beni
Hallo Thorsten,
kopiere diesen Code ins Modul von Tabelle1 und selektioniere eine Zelle in SpalteA und die Daten werden in Tabelle3 übertragen, ich habe es getestet und es funktioniert.
Gruss Beni


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'von bernhard Mächler
If Target.Column = 1 Then
Wert = Cells(Target.Row, 3)
With Worksheets(2).Columns(6)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
MsgBox "nicht vorhanden"
Exit Sub
End If
If Cells(Target.Row, 4) = C(1, 4) Then
Dim lRow As Long
With Worksheets(3)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Cells(Target.Row, 1)
.Cells(lRow, 2).Value = C(1, -4)
.Cells(lRow, 3).Value = C(1, -3)
.Cells(lRow, 4).Value = C(1, -2)
.Cells(lRow, 5).Value = C(1, -1)
.Cells(lRow, 6).Value = C(1, 0)
.Cells(lRow, 7).Value = C(1, 1)
.Cells(lRow, 8).Value = C(1, 2)
.Cells(lRow, 9).Value = C(1, 3)
.Cells(lRow, 9).Value = C(1, 4)
End With
End If
End With
End If
End Sub

Anzeige
AW: Spaltenvergleich mit 3 Bedingungen und Kopie
18.09.2003 16:19:07
Thorsten
Hi Beni,

habe den code in das Modul 1 kopiert, nur leider läßt sich das makro nicht ausführen... woran liegt das ?
AW: Spaltenvergleich mit 3 Bedingungen und Kopie
18.09.2003 18:07:59
Beni
Hallo Thorsten,
das ist ein automatisches Makro, das wir ausgeführt, wenn Du in SpallteA eine Zelle selektionierst, darum gehört es das in Modul von Tabelle1, rechte Maustaste auf Blattregister/Code anzeigen/einfügen.
Gruss Beni
Teilweise Funktion
18.09.2003 19:02:04
Thorsten
Hi,

habe das nun zum laufen bekommen, hatte zunächst nicht beachtet, dass die Zellen angewählt werden müssen.
Allerdings sind 2 Sachen noch nicht so ganz, wie ich sie mir vorgestellt habe

a) die interior color der eingefügten Zellen in Tabelle 3 wird nicht in der abhängigkeit von ja und nein bestimmt
b) leider muss man immer jede Zelle selektieren, um die überprüfung für die einzelnen zeilen zu starten. geht das auch automatisch, zum bsp. mit eine sub, die ich an eine userform knüpfen kann?

Im moment ist es leider so, dass wenn eine Zelle in Tabelle 1 mehrmals selektiert wird, die kopie mehrmals erstellt und ein gefügt wird. wäre schön, wenn das nciht passieren würde
Anzeige
AW: Teilweise Funktion
18.09.2003 20:29:15
Beni
Hallo Thorsten,
die Daten werden nur einmal übertragen, die Farbe wird mitgenommen und zum überprüfen, musst Du nur von A1 mit der Pfeiltaste Curser nach unten bis Ende bewegen.
Gruss Beni


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'von Bernhard Mächler
If Target.Column = 1 Then
Wert1 = Target
With Worksheets(3).Columns(1)
Set C = .Find(Wert1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then Exit Sub
End With
Wert = Cells(Target.Row, 3)
With Worksheets(2).Columns(6)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then
MsgBox "nicht vorhanden"
Exit Sub
End If
If Cells(Target.Row, 4) = C(1, 4) Then
Dim lRow As Long
With Worksheets(3)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Cells(Target.Row, 1)
.Cells(lRow, 2).Value = C(1, -4)
.Cells(lRow, 3).Value = C(1, -3)
.Cells(lRow, 4).Value = C(1, -2)
.Cells(lRow, 5).Value = C(1, -1)
.Cells(lRow, 6).Value = C(1, 0)
.Cells(lRow, 7).Value = C(1, 1)
.Cells(lRow, 8).Value = C(1, 2)
.Cells(lRow, 9).Value = C(1, 3)
.Cells(lRow, 9).Value = C(1, 4)
If Cells(Target.Row, 8) = "ja" Then
.Cells(lRow, 1).Interior.ColorIndex = 4
.Cells(lRow, 2).Interior.ColorIndex = 4
.Cells(lRow, 3).Interior.ColorIndex = 4
.Cells(lRow, 4).Interior.ColorIndex = 4
.Cells(lRow, 5).Interior.ColorIndex = 4
.Cells(lRow, 6).Interior.ColorIndex = 4
.Cells(lRow, 7).Interior.ColorIndex = 4
.Cells(lRow, 8).Interior.ColorIndex = 4
.Cells(lRow, 9).Interior.ColorIndex = 4
End If
If Cells(Target.Row, 8) = "nein" Then
.Cells(lRow, 1).Interior.ColorIndex = 3
.Cells(lRow, 2).Interior.ColorIndex = 3
.Cells(lRow, 3).Interior.ColorIndex = 3
.Cells(lRow, 4).Interior.ColorIndex = 3
.Cells(lRow, 5).Interior.ColorIndex = 3
.Cells(lRow, 6).Interior.ColorIndex = 3
.Cells(lRow, 7).Interior.ColorIndex = 3
.Cells(lRow, 8).Interior.ColorIndex = 3
.Cells(lRow, 9).Interior.ColorIndex = 3
End If
End With
End If
End With
End If
End Sub

Anzeige
Teilweise Funktion
18.09.2003 20:38:16
Thorsten
Klasse Beni,

bin echt super dankbar für die großzügige Hilfe, wenn man dass Makro nun noch mittels ner Userform starten könnte, ohne dass der User die Zellen anwähelne muss... könnte man das eventuell über nen befehl machen, der der Reihe nach die Zellen der Spalte A abfragt, und daudrch dann immer die Zelle aktiviert und dann bei der ner leeren Zelle aufhört??

Wäre klasse, wenn du das auch noch hinbekommen würdest
AW: Teilweise Funktion
18.09.2003 21:57:54
Beni
Hallo Thorten,
jetzt kannst Du dieses Makro aus einer UserForm starten.
Gruss Beni


Private Sub CommandButton1_Click()
'18.09.03 von Bernhard Mächler
Sheets(1).Select
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To intLastRow
Wert = i
With Worksheets(3).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then GoTo 1
End With
Wert = Cells(i, 3).Value
With Worksheets(2).Columns(6)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then Exit Sub
If Cells(i, 4) = C(1, 4) Then
Dim lRow As Long
With Worksheets(3)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Cells(i, 1)
.Cells(lRow, 2).Value = C(1, -4)
.Cells(lRow, 3).Value = C(1, -3)
.Cells(lRow, 4).Value = C(1, -2)
.Cells(lRow, 5).Value = C(1, -1)
.Cells(lRow, 6).Value = C(1, 0)
.Cells(lRow, 7).Value = C(1, 1)
.Cells(lRow, 8).Value = C(1, 2)
.Cells(lRow, 9).Value = C(1, 3)
.Cells(lRow, 9).Value = C(1, 4)
If Cells(i, 8) = "ja" Then
.Cells(lRow, 1).Interior.ColorIndex = 4
.Cells(lRow, 2).Interior.ColorIndex = 4
.Cells(lRow, 3).Interior.ColorIndex = 4
.Cells(lRow, 4).Interior.ColorIndex = 4
.Cells(lRow, 5).Interior.ColorIndex = 4
.Cells(lRow, 6).Interior.ColorIndex = 4
.Cells(lRow, 7).Interior.ColorIndex = 4
.Cells(lRow, 8).Interior.ColorIndex = 4
.Cells(lRow, 9).Interior.ColorIndex = 4
End If
If Cells(i, 8) = "nein" Then
.Cells(lRow, 1).Interior.ColorIndex = 3
.Cells(lRow, 2).Interior.ColorIndex = 3
.Cells(lRow, 3).Interior.ColorIndex = 3
.Cells(lRow, 4).Interior.ColorIndex = 3
.Cells(lRow, 5).Interior.ColorIndex = 3
.Cells(lRow, 6).Interior.ColorIndex = 3
.Cells(lRow, 7).Interior.ColorIndex = 3
.Cells(lRow, 8).Interior.ColorIndex = 3
.Cells(lRow, 9).Interior.ColorIndex = 3
End If
End With
End If
End With
1:
Next
End Sub

Anzeige
AW: Teilweise Funktion
18.09.2003 23:36:15
Thorsten
Hi,

danke Beni für die Bemühungen, werde das allerdings vor morgen früh nicht mehr testen können. Ich weiß deine Hilfe zu schätzen, recht herzlichen Dank nochmals
AW: Teilweise Funktion
19.09.2003 07:56:26
Beni
Hallo Thorsten,
ich habe noch einen Fehler endeckt, wenn Daten nicht überein stimmten wurde Makro beendet und hatte nicht nach weiteren übereistimmungen gesucht, mit diesem sollte es funktionieren.
Gruss Beni


Private Sub CommandButton1_Click()
'18.09.03 von Bernhard Mächler
Sheets(1).Select
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To intLastRow
Wert = i
With Worksheets(3).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then GoTo 1
End With
Wert = Cells(i, 3).Value
With Worksheets(2).Columns(6)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If C Is Nothing Then GoTo 1
If Cells(i, 4) = C(1, 4) Then
Dim lRow As Long
With Worksheets(3)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Cells(i, 1)
.Cells(lRow, 2).Value = C(1, -4)
.Cells(lRow, 3).Value = C(1, -3)
.Cells(lRow, 4).Value = C(1, -2)
.Cells(lRow, 5).Value = C(1, -1)
.Cells(lRow, 6).Value = C(1, 0)
.Cells(lRow, 7).Value = C(1, 1)
.Cells(lRow, 8).Value = C(1, 2)
.Cells(lRow, 9).Value = C(1, 3)
.Cells(lRow, 9).Value = C(1, 4)
If Cells(i, 8) = "ja" Then
.Cells(lRow, 1).Interior.ColorIndex = 4
.Cells(lRow, 2).Interior.ColorIndex = 4
.Cells(lRow, 3).Interior.ColorIndex = 4
.Cells(lRow, 4).Interior.ColorIndex = 4
.Cells(lRow, 5).Interior.ColorIndex = 4
.Cells(lRow, 6).Interior.ColorIndex = 4
.Cells(lRow, 7).Interior.ColorIndex = 4
.Cells(lRow, 8).Interior.ColorIndex = 4
.Cells(lRow, 9).Interior.ColorIndex = 4
End If
If Cells(i, 8) = "nein" Then
.Cells(lRow, 1).Interior.ColorIndex = 3
.Cells(lRow, 2).Interior.ColorIndex = 3
.Cells(lRow, 3).Interior.ColorIndex = 3
.Cells(lRow, 4).Interior.ColorIndex = 3
.Cells(lRow, 5).Interior.ColorIndex = 3
.Cells(lRow, 6).Interior.ColorIndex = 3
.Cells(lRow, 7).Interior.ColorIndex = 3
.Cells(lRow, 8).Interior.ColorIndex = 3
.Cells(lRow, 9).Interior.ColorIndex = 3
End If
End With
End If
End With
1:
Next
End Sub

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige