Suche in Spalte nach zwei Kriterien

Moderator: ModerationP

Suche in Spalte nach zwei Kriterien

Beitragvon Sascha06 » 28. Feb 2019, 22:26

Hallo an alle,
habe ein Problem, mit dem ich mich schon sehr lange befasse. Meine programmier Kentnisse sind noch nicht die besten, bin aber bis jetzt noch auf alles gekommen.
Folgendes möchte ich realisieren.

Suche in Spalte 45 von Tabelle 1 nach einem >schwarzen< x . Kopiere mir, wenn x und Textfarbe schwarz die Zellen aus Spalte 10,14,17,21,22,24,und 26. Nach dem Kopieren soll die Schriftfarbe vom diesem x in >rot< gefärbt werden. Danach sollen die kopierten Zelle von Tabelle 1 nach Tabelle 2, ab der nächsten freien Zeile, in die Zellen der Spalten B,C,D,E,F,G und H geschrieben werden. In Spalte A von Tabelle 2 soll eine fortlaufende Nummer eingetragen werden bis ende der kopierten Zellen.
usw.

Danke schon mal an alle
Gruß Sascha

Hier mein Code, ab da, wo ich nicht mehr weiter komme.

Sub ListeFuellen()
Dim zeil As Integer, spalt As Integer
Dim iRow As Long
Dim z As Integer, s As Integer
Dim Barc As String
Dim PlAdAl As String
Dim Bene As String
Dim EDat As String
Dim ADat As String
Dim Ausg As String
Dim TFor As String


ThisWorkbook.Worksheets("Tabelle1").Select
With Sheets("Tabelle1")

For iRow = 5 To WorksheetFunction.Count(Columns(1)) '
If Cells(iRow, 45).Value = "x" Then 'Suchen in Spalte 45 nach x

Barc = Worksheets("Tabelle1").Cells(iRow, 10).Value
PlAdAl = Worksheets("Tabelle1").Cells(iRow, 14).Value
Bene = Worksheets("Tabelle1").Cells(iRow, 17).Value
EDat = Worksheets("Tabelle1").Cells(iRow, 21).Value
ADat = Worksheets("Tabelle1").Cells(iRow, 22).Value
Ausg = Worksheets("Tabelle1").Cells(iRow, 24).Value
TFor = Worksheets("Tabelle1").Cells(iRow, 26).Value

End If
Next iRow

ThisWorkbook.Worksheets("Tabelle2").Select
Range("A1").Select
zeil = ActiveSheet.UsedRange.Rows.Count 'letzte ausgef?llte Zeile

For z = 17 To zeil
If Cells(z, 3).Value = SuchPNummer Then Exit Sub


Range(Cells(z, 3), Cells(z, 3)).Select 'gefundene Zelle selektieren
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1) = "1"
Range("B" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = Barc
Range("C" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = PlAdAl
Range("D" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = Bene
Range("E" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = EDat
Range("F" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = ADat
Range("G" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = Ausg
Range("H" & Cells(Rows.Count, "A").End(xlUp).Row + 0) = TFor

Next z
End With

End Sub
Zuletzt geändert von shift-del am 28. Feb 2019, 22:44, insgesamt 1-mal geändert.
Grund: Thema nach Excel Forum verschoben
Sascha06
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 7
Registriert: 28. Feb 2019, 22:06

Re: Suche in Spalte nach zwei Kriterien

Beitragvon TommyDerWalker » 01. Mär 2019, 07:37

Sascha06 hat geschrieben:Suche in Spalte 45 von Tabelle 1 nach einem >schwarzen<


Ob das politisch korrekt ist... :mrgreen:
Windows10 PRO 64Bit MSOffice32Bit/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto http://www.office-loesung.de/p
On Error GoTo Hell
Benutzeravatar
TommyDerWalker
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 1081
Registriert: 16. Jan 2015, 14:49
Wohnort: Wuppertal NRW

Re: Suche in Spalte nach zwei Kriterien

Beitragvon Xlsibb » 01. Mär 2019, 10:17

Hallo Sascha,

ungetestet, aber so vielleicht?

Code: Alles auswählen
Sub ListeFuellen()

Dim iRow As Long, iRow2 As Long
Dim lngCount As Long

With Sheets(2)
    iRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With

lngCount = 1

With Sheets(1)
    For iRow = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(iRow, 45).Font.Color = RGB(0, 0, 0) And (.Cells(iRow, 45).Value = "x" Or .Cells(iRow, 45).Value = "X") Then
            Sheets(2).Cells(iRow2, 1).Value = lngCount
            Sheets(2).Cells(iRow2, 2).Value = .Cells(iRow, 10).Value
            Sheets(2).Cells(iRow2, 3).Value = .Cells(iRow, 14).Value
            Sheets(2).Cells(iRow2, 4).Value = .Cells(iRow, 17).Value
            Sheets(2).Cells(iRow2, 5).Value = .Cells(iRow, 21).Value
            Sheets(2).Cells(iRow2, 6).Value = .Cells(iRow, 22).Value
            Sheets(2).Cells(iRow2, 7).Value = .Cells(iRow, 24).Value
            Sheets(2).Cells(iRow2, 8).Value = .Cells(iRow, 26).Value
            .Cells(iRow, 45).Font.Color = RGB(255, 0, 0)
            iRow2 = iRow2 + 1
            lngCount = lngCount + 1
        End If
    Next iRow

End Sub
Benutzeravatar
Xlsibb
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 1175
Registriert: 26. Feb 2009, 17:07

Re: Suche in Spalte nach zwei Kriterien

Beitragvon Sascha06 » 01. Mär 2019, 20:43

Hallo Xlsibb ,

vielen Dank. Funktioniert super. :P
Da währe ich nicht drauf gekommen
Danke Gruß Sascha
Sascha06
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 7
Registriert: 28. Feb 2019, 22:06


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: MemoMS und 27 Gäste