Ich habe eine Excel-Datei, welche Daten enthält, die als Benutzerdefiniert markiert sind; z.B. bei 25 €, sehe ich das Währungszeichen in der Bearbeitungsleiste nicht. Dazu habe ich ein Programmcode, die aber nicht korrekt funktioniert, falls ich mehrere Spalten darstellen möchte. Kann jemand mir dabei helfen?
Hier ist der Code:
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
'eing = InputBox("Suchspalte")
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)
' Find the first quote sign in the custom format
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
' Find the second quote sign in the custom format
If FirstQuote = True Then
If Asc(x) = 34 Then
SecondQuote = True
GoTo TheEnd
End If
End If
' Write out the characters between the first and second quote
If FirstQuote = True And SecondQuote = False Then
CustomFormatText = CustomFormatText + x
End If
GetNextCharacter:
Next i
TheEnd:
End Function
|