Option Explicit
Sub BWTest()
Dim eing As Integer
Dim eing2 As Integer
Dim s As Integer
Application.ScreenUpdating = False
ende = ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Range("b12000000").End(xlUp).Row
eing2 = InputBox("Ausgabe Zelle")
For k = 96 To ende
s = Cells(k, Columns.Count).End(xlToLeft).Column
For y = 9 To eing2 - 1
If Cells(k, y).Value = 0 Then
Cells(k, y).Value = ""
End If
Next y
s = Cells(k, Columns.Count).End(xlToLeft).Column
If s = 1 Then
Rows(k).Delete
Else
Waehrung = CustomFormatText(ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Cells(k, s))
If Waehrung <> "*" And Waehrung <> "" Then
ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Cells(k, eing2).Value = Waehrung
End If
End If
Next k
Application.ScreenUpdating = True
End Sub
Function CustomFormatText(Cell) As String
Dim i As Long
Dim x As String
Dim CustomFormatString As String
Dim FirstQuote As Boolean
Dim SecondQuote As Boolean
FirstQuote = False
SecondQuote = False
CustomFormatString = Cell.NumberFormat
If Right(CustomFormatString, 1) = "$" Then
CustomFormatText = "$"
GoTo TheEnd
End If
For i = 1 To Len(CustomFormatString)
x = Mid$(CustomFormatString, i, 1)
If FirstQuote = False Then
If Asc(x) = 34 Then
If x = "$" Then
CustomFormatText = "$"
GoTo TheEnd
End If
FirstQuote = True
GoTo GetNextCharacter
End If
End If
If FirstQuote = True Then
If Asc(x) = 34 Then
SecondQuote = True
GoTo TheEnd
End If
End If
If FirstQuote = True And SecondQuote = False Then
CustomFormatText = CustomFormatText + x
End If
GetNextCharacter:
Next i
TheEnd:
End Function