Sub inExcel()
Dim Zellen, Begriffe
Dim x As Long, y As Long
Begriffe = Array("X", "Y") 'Reihenfolge bestimmt Überschreiben in Spalte 1
Zellen = Cells(1).CurrentRegion.Value
For x = LBound(Zellen, 1) To UBound(Zellen, 1)
For y = 2 To UBound(Zellen, 2)
If Zellen(x, y) = Begriffe(1) And Zellen(x, 1) <> Begriffe(0) Then _
Zellen(x, 1) = Begriffe(1)
If Zellen(x, y) = Begriffe(0) And Zellen(x, 1) <> Begriffe(0) Then _
Zellen(x, 1) = Begriffe(0)
Next y
Next x
Cells(1).CurrentRegion.Value = Zellen
End Sub
|