Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelleninhalt wird falsch formatiert

Zelleninhalt wird falsch formatiert
12.12.2008 12:43:00
christian
Die Vorgeschichte:
Hi
Wir brauchen etwas ähnliches wie in diesem Script von Daniel (der uns schon sehr weitergeholfen hat!):
https://www.herber.de/bbs/user/57225.xls
Zeilen sollen zusammengefasst werden, wenn die Bezeichnung in Spalte A und B gleich sind (siehe Screenshots).
https://www.herber.de/bbs/user/57373.jpg
https://www.herber.de/bbs/user/57374.jpg
Danke im Vorraus!
mfg
Christian
Vielen Dank Franz!
Noch eine Kleinigkeit, kann dieser Code so umgeschrieben werden, dass nur die Zeilen betroffen sind die in Spalte 8 "Geschenkartikel" stehen haben und das zB Spalte 4 in der neuen Tabelle gelöscht wird?
Danke!
mfg
Christian
Hallo Christian,
folgende nicht getestete Version sollte funktionieren.
Die Zeilen, die nicht dem Kriterium entsprechen werden vor dem Zusammenfaqssen gelöscht.
Die nicht gewünschten Spalten werden zum Schluß gelöscht.
Gruß
Franz

Sub Zusammenfassen()
Dim ze As Long, varWert, Zeile As Long
Dim shA As Worksheet
Dim shE As Worksheet
Set shA = Sheets("Ausgangsdaten")
Set shE = Sheets("Ergebnis")
shA.UsedRange.Copy shE.Cells(1, 1)
With shE
'Alle Zeilen verschieden von Geschenkartikel in Spalte 8 löschen
varWert = "Geschenkartikel"
For ze = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
'Vergleichswert mit Zellinhalten vergleichen
If varWert  .Cells(ze, 8).Text Then
.Rows(ze).Delete shift:=xlShiftUp
End If
Next
'Spalten vertikal formatieren (zentriert)
With .Range(.Columns(1), .Columns(6))
.VerticalAlignment = xlVAlignCenter
End With
'Spalten als Text formatieren (ohne Spalten mit Dezimalwerten!)
With .Range(.Columns(1), .Columns(5))
.NumberFormat = "@"
End With
'Letzte Zeile ermitteln
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Nummerischen Wert in Spalte merken und als Text in Zelle eintragen
varWert = .Cells(Zeile, 6).Text
With .Cells(Zeile, 6)
.NumberFormat = "@"
.Value = varWert
End With
'1. Vergleichswert
varWert = .Cells(Zeile, 1).Text & .Cells(Zeile, 2).Text
For ze = .Cells(Rows.Count, 1).End(xlUp).Row - 1 To 2 Step -1
'Vergleichswert mit Zellinhalten vergleichen
If varWert = .Cells(ze, 1).Text & .Cells(ze, 2).Text Then
.Cells(Zeile, 3) = .Cells(ze, 3).Text & Chr(10) & .Cells(Zeile, 3).Text
.Cells(Zeile, 4) = .Cells(ze, 4).Text & Chr(10) & .Cells(Zeile, 4).Text
.Cells(Zeile, 6) = .Cells(ze, 6).Text & Chr(10) & .Cells(Zeile, 6).Text
.Rows(ze).ClearContents
Else
Zeile = ze 'neue Zeile für "addieren" von Zellinhalten merken
'Inhalt von Zellen mit Nummerischen Werten merken und als Text in Zellen eintragen
varWert = .Cells(Zeile, 6).Text
With .Cells(Zeile, 6)
.NumberFormat = "@"
.Value = varWert
End With
'Neuer Vergleichswert
varWert = .Cells(Zeile, 1).Text & .Cells(Zeile, 2).Text
End If
Next
'Nachkomma-Nullen ersetzen
.Columns(6).Replace ",00", ",--"
'Leerzeilen löschen
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Spalten löschen
.Columns(4).Delete shift:=xlShiftToLeft
End With
End Sub


Der Code funktinoiert super, nur ein Problem gibts es noch, die Zahlen in der Spalte Artikelnummer werden wissenschaftlich formatiert in der neuen Tabelle, wie kann ich das verhindern?
mfg
Christian
Hallo Christian,
formatiere in den Ausgangsdaten die Spalte mit dem Format Zahlen ohne Nachkommastellen und ohne Tausenderpunkt. Dann sollte es funktionieren.
Alternativ: Artikelnummern in Ausgamgsdaten als Text formatieren.
Gruß
Franz
Leider funktioniert die von Franz vorgeschlagene Lösung nicht, die Zelleninhalte werden so dargestellt, als ob die Spaltenbreite zu klein wär, würde es helfen im Makro die Spaltenbreite im Vorhinein zu ändern oder kennt jemand eine andere Lösung dafür?

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelleninhalt wird falsch formatiert
12.12.2008 13:21:19
Wenderhold
hi christian

Public Sub merge_contents()
Dim i As Long, xx As Long
Dim szA, szB, szC, szD As String
Dim wbS As Worksheet, wbE As Worksheet
Set wbS = ActiveSheet
Set wbE = Sheets(2)
xx = 1
For i = 1 To 65536
If wbS.Cells(i, 1).Value = "" Then Exit For
szA = CStr(wbS.Cells(i, 1).Value)
szB = CStr(wbS.Cells(i, 2).Value)
szC = CStr(wbS.Cells(i, 3).Value)
szD = CStr(wbS.Cells(i, 4).Value)
If szA = wbS.Cells(i + 1, 1).Value And _
szB = wbS.Cells(i + 1, 2).Value Then
Do While True
i = i + 1
szC = szC + Chr(10) + CStr(wbS.Cells(i, 3).Value)
szD = szD + Chr(10) + CStr(wbS.Cells(i, 4).Value)
If szA  wbS.Cells(i + 1, 1).Value Or _
szB  wbS.Cells(i + 1, 2).Value Then Exit Do
Loop
End If
' und auf wbe wegschreiben
wbE.Cells(xx, 1).Value = szA
wbE.Cells(xx, 2).Value = szB
wbE.Cells(xx, 3).Value = szC
wbE.Cells(xx, 4).Value = szD
xx = xx + 1
Next i
End Sub


der sollte das machen.
greeze
e

Anzeige
AW: Zelleninhalt wird falsch formatiert
12.12.2008 13:24:16
christian
danke für die rasche antwort, wo wird dieser Code am besten in den bestehenden eingefügt?
mfg
Christian
AW: Zelleninhalt wird falsch formatiert
12.12.2008 14:11:00
Wenderhold
hi
keine ahnung, ich weiss ja nicht, in welcher reihenfolge
eure makros arbeiten und kenn auch nicht den workflow
greeze
e
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge