Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Read more about this makro for Axure Wireframing-Software at http://uxzentrisch.de/axure-funktionstexte/
Option Explicit
Sub Clean()
Rows("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Size = 12
Selection.Font.Size = 14
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Columns("F:F").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub Remove()
On Error Resume Next
Dim Z As Integer
Sheets("Tabelle1").Activate
ActiveSheet.Unprotect = "Passwort"
Application.ScreenUpdating = False
For Z = 1000 To 2 Step -1
If Mid(Cells(Z, 3), 1, 2) <> "ab" Or Mid(Cells(Z, 3), 1, 2) = "ab" And Cells(Z, 5) = "" And Cells(Z, 6) = "" Then Rows(Z).Delete
Next Z
Application.ScreenUpdating = True
End Sub
Sub Doppelte_Labels()
Dim i As Long
Dim lngLastR As Long
lngLastR = Cells(Rows.Count, "C").End(xlUp).Row + 1
'Zellinhalte in Spalte F durch "" = Leerzelle ersetzen
Do
i = i + 1
Range(Cells(i + 1, "C"), Cells(lngLastR, "C")).Replace _
what:=Cells(i, "C").Value, replacement:="", lookat:=xlWhole
Loop While WorksheetFunction.CountIf(Range(Cells(i + 1, "C"), Cells(lngLastR, "C")), "") < (lngLastR - i)
'Zeilen löschen, die Leerezellen in Spalte F haben:
Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub Main()
Call Clean
Call Remove
Call Doppelte_Labels
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment