|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
 Benutzerdefinierte Markierung |
07.07.2016 15:42:53 |
elazig23 |
|
|
|
08.07.2016 08:30:33 |
Gast71140 |
|
|
|
11.07.2016 11:34:52 |
Gast66277 |
|
|
|
11.07.2016 19:12:49 |
Gast37955 |
|
|
|
14.07.2016 15:43:06 |
elazig23 |
|
|
|
15.07.2016 02:48:34 |
Gast62166 |
|
|
|
18.07.2016 10:54:05 |
elazig23 |
|
|
Von:
elazig23 |
Datum:
07.07.2016 15:42:53 |
Views:
1158 |
Rating:
|
Antwort:
|
Thema:
Benutzerdefinierte Markierung |
|
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
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
Benutzerdefinierte Markierung |
07.07.2016 15:42:53 |
elazig23 |
|
|
|
08.07.2016 08:30:33 |
Gast71140 |
|
|
|
11.07.2016 11:34:52 |
Gast66277 |
|
|
|
11.07.2016 19:12:49 |
Gast37955 |
|
|
|
14.07.2016 15:43:06 |
elazig23 |
|
|
|
15.07.2016 02:48:34 |
Gast62166 |
|
|
|
18.07.2016 10:54:05 |
elazig23 |
|
|