Formatiert nur eine Spalte statt zwei
18.10.2013 17:22:32
Mike
ich verzweifle an folgendem Problem:
Ich übertrage per Makro Werte aus mehreren Spalten von einem Tabellenblatt auf ein anderes.
Anschließend sollen auf dem neuen Tabellenblatt die Spalten formatiert werden (Währung).
Bei mir wird aber nur die erste Spalte korrekt formatiert z. B. 2,40
Bei der zweiten Spalte steht aber immer nur 2,4 und ich kann keine Summen aufaddieren. Erst wenn ich in die Zelle einmal reingeklickt habe und wieder rausgehe wird sie korrekt dargestellt und kann addiert werden.
Ich habe es auch schon mit
.NumberFormat = "#,##0.00 $" etc. probiert, aber es geht einfach nicht.
Ist mein Makro falsch oder scheiter ich an irgendeiner Einstellung in Excel?
Hier mal das Makro:
Sub Abrechnung()
Dim intIndexAbrechnung As String
Dim intIndexErfassung As String
Dim intIndexKontrolle As String
Dim strErfassung_B As String
Dim strErfassung_C As String
Dim strSearchKey As String
Dim aktKey As String
Dim TableToEnd As Boolean
Dim intFound As Integer
Dim waehrung As String
'// Initialisierung
searchKey = Sheets(3).Range("C1")
TableToEnd = False
intIndexAbrechnung = 3
intIndexErfassung = 1
intIndexKontrolle = 1
intFound = 0
waehrung = " "
'// Werte löschen
Sheets(3).Range("A" & intIndexAbrechnung, "C5000").Clear
'// So lange Sheet-2 gefüllt ist
While Not TableToEnd
'// Zelleninformation aus Sheet 2 holen
aktKey = Sheets(2).Range("A" & intIndexKontrolle)
strErfassung_B = Sheets(2).Range("B" & intIndexKontrolle)
strErfassung_C = Sheets(2).Range("C" & intIndexKontrolle)
'// Vergleich eingegebener Wert und aktueller Wert
If searchKey = aktKey Then
'// Wenn gleich, dann schreibe Werte aus Sheet 2 auf Sheet 3
Sheets(3).Range("A" & intIndexAbrechnung) = aktKey
Sheets(3).Range("C" & intIndexAbrechnung) = strErfassung_C
Sheets(3).Range("B" & intIndexAbrechnung) = strErfassung_B
'// Zeile in Sheet 2 löschen
Sheets(2).Rows(intIndexKontrolle).Delete
'// Formartieren in
Sheets(3).Range("B" & intIndexAbrechnung).NumberFormat = "#,##0.00" & """" & waehrung & _
_
_
Sheets(3).Range("C" & intIndexAbrechnung).NumberFormat = "#,##0.00" & """" & waehrung & _
_
_
'// Increment
intIndexAbrechnung = intIndexAbrechnung + 1
intIndexKontrolle = intIndexKontrolle - 1
intFound = intFound + 1
End If
'// Abschluss
intIndexKontrolle = intIndexKontrolle + 1
If aktKey = "" Then TableToEnd = True
Wend
'// Keine gefunden?
If (intFound = 0) Then MsgBox "Keine gefunden!", vbInformation, "Blöd!"
'druckt Rechnung aus
Dim Kopien As Variant
If MsgBox("Rechnung ausdrucken?", vbYesNo, "Drucken") = vbYes Then
Do
Kopien = InputBox("Anzahl Kopien", "Drucken", 1)
If StrPtr(Kopien) = 0 Then Exit Sub
If IsNumeric(Kopien) Then Exit Do
MsgBox "Bitte eine Zahl eingeben!", vbExclamation, "Hinweis"
Loop
ActiveSheet.PrintOut From:=1, To:=1, Copies:=CLng(Kopien)
End If
End Sub
Vielen Dank im Voraus.
Gruß
Mike