wert einer übertragen und zeilen löschen

28/09/2008 - 00:55 von hampe | Report spam
hallo ng

ich brauche hilfe bei folgendem problem:

vista home + excel 2007, sp 1: tabelle mit rd 209000 zeilen (sieht
"auzusgsweise" wie folgt aus):

matnummer kurztext
frz-typ1 frz-typ2 frz-typ3 frz-typ4
98005622 Lehre Druckhülse Ø270 x 300mm RABe 520
98005623 Lehre Druckhülse Ø205 x 300mm RABe 520
98005624 Lehre Führungsschale Ø208 x 60mm RABe 520
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. WR EW
IV
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. WR EW
V
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. WRm IV
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. A EW
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. A IC
2000

nun sollen alle frz-typen auf einer zeile (und nicht untereinander)
"stehen, d.h. ich brauche ein vba-code, der
sofern hintereinander mehrere gleiche mat-nummern folgen, die frzg-
typen in die zellen frzg-typ 2, usw. übertragen
werden und dann die zeilen gelöscht werden.
beispiel: 98005622 passiert nichts, 98006061 werden die
unterschiedlichen frz-typen in die erste zeile mit der
matnummer übertragen und die restlichen zeilen gelöscht, d.h. es
müsste dann so aussehen:

matnummer kurztext
frz-typ1 frz-typ2 frz-typ3 frz-typ4
98005622 Lehre Druckhülse Ø270 x 300mm RABe 520
98005623 Lehre Druckhülse Ø205 x 300mm RABe 520
98005624 Lehre Führungsschale Ø208 x 60mm RABe 520
98006061 Hilfswelle Ø40 x 368 mm f. Verflüssiger. WR EW
IV WR EW V WRm IV A EW usw.

danke im voraus für die unterstützung und gruss
hampa
 

Lesen sie die antworten

#1 Andreas Killer
28/09/2008 - 13:01 | Warnen spam
hampe schrieb:

nun sollen alle frz-typen auf einer zeile (und nicht untereinander)
"stehen, d.h. ich brauche ein vba-code, der
sofern hintereinander mehrere gleiche mat-nummern folgen, die frzg-
typen in die zellen frzg-typ 2, usw. übertragen
werden und dann die zeilen gelöscht werden.



Sub Bereinigen()
Dim Y As Long, I As Long

'Materialnummer steht in Spalte 1
Const MatCol = 1
'Frz-Typen stehen ab Spalte 3
Const FrzCol = 3
'Datenbeginn ab Zeile 3
Y = 3
'Durchlaufe alle Zeilen solange was da ist
Do While Cells(Y, MatCol) <> ""
'Gleiche Matnr in nàchster Zeile?
If Cells(Y, MatCol) = Cells(Y + 1, MatCol) Then
'Datenbeginn
I = FrzCol
'Gehe nach rechts solange was da ist
Do While Cells(Y, I) <> "" Or Cells(Y + 1, I) <> ""
'Die Frz-Typen der nàchsten Zeile in diese holen
Cells(Y, I) = Trim(Cells(Y, I) & " " & Cells(Y + 1, I))
I = I + 1
Loop
'Nàchste Zeile löschen
Rows(Y + 1).Delete
Else
'Nàchste Zeile
Y = Y + 1
End If
Loop
End Sub

Tschüs, Andreas.

Ähnliche fragen