If - Abfrage verkürzen
03.08.2003 09:12:11
Erich M.
ich habe aus dem Forum ein Makro von ChrisL, das ich auf meine Bedürfnisse anpassen wollte. Es werden Daten in einer Spalte gesucht, die mit den Daten in einer anderen Spalte übereinstimmen.
Dann werden diese übereinstimmenden in eine neue Tabelle kopiert. Soweit kein Problem.
Ich möchte aber erreichen, dass die komplette Zeile der übereinstimmenden Daten kopiert wird.
Derzeit behelfe ich mir, dass ich für jede Spalte die kopiert werden soll eine eigen If-Abfrage erstelle.
Kann man das vereinfachen? Mit iRow, Row oder ähnlichem hatte ich keinen Erfolg:
Sub AA_Kopieren()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim iZeile As Long, LetzteZeile As Long, iRow As Long
Dim myName1 As String, myName2 As String, myName3 As String
Dim mySpalte1 As String, mySpalte2 As String
myName1 = InputBox("Ausgangstabelle")
mySpalte1 = InputBox("Spalte Ausgangstabelle")
myName2 = InputBox("Vergleichstabelle")
mySpalte2 = InputBox("Spalte Vergleichstabelle")
Set WS1 = Worksheets(myName1)
Set WS2 = Worksheets(myName2)
Set WS3 = Worksheets("T3")
Sheets("T3").Cells.Clear
LetzteZeile = WS2.Range("A65536").End(xlUp).Row
For iZeile = 2 To WS1.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(WS2.Range("A2:A" & LetzteZeile), WS1.Cells(iZeile, 1)) _
= 1 Then WS1.Cells(iZeile, 1).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row + 1, 1)
If WorksheetFunction.CountIf(WS2.Range("A2:A" & LetzteZeile), WS1.Cells(iZeile, 1)) _
= 1 Then WS1.Cells(iZeile, 2).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 2)
If WorksheetFunction.CountIf(WS2.Range("A2:A" & LetzteZeile), WS1.Cells(iZeile, 1)) _
= 1 Then WS1.Cells(iZeile, 3).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 3)
If WorksheetFunction.CountIf(WS2.Range("A2:A" & LetzteZeile), WS1.Cells(iZeile, 1)) _
= 1 Then WS1.Cells(iZeile, 4).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 4)
Next iZeile
Sheets("T3").Activate
Range("C1").Select
End Sub
Code eingefügt mit: Excel Code Jeanie
Besten Dank für eine Hilfe!
mfg
Erich