Zeilen kopieren und aufsplitten

[Rabe]

Hi Uwe,

hier eine Arrayvariante:

ich habe jetzt die letzten 2,5 Stunden damit verbracht, das Array-Makro einzuarbeiten.
Da immer falsche Ergebnisse auftauchten im weiteren Makroverlauf, muß das restliche Makro angepasst werden, das ist aber ein größerer Aufwand.

Ich schreib Dir mal ne PN / E-Mail.

[Edit]
so, nach Übersendung der Original-Dateien und einigen Anpassungen läuft es nun einwandfrei! Danke!

[Rabe]

Hi Uwe u.a.,

[Edit]
so, nach Übersendung der Original-Dateien und einigen Anpassungen läuft es nun einwandfrei! Danke!

ich habe nun die gleiche Aufgabe für das Makro mit einer anderen BOM-Tabelle, diese sieht folgendermaßen aus.
Es sind also nur 3 Spalten, die verknüpft und in die Tabelle "Gesamt" kopiert werden sollen. Jedes Bauteil kommt nur ein Mal vor, es muß also nicht aufgesplittet werden nach Bauteilsummierung (Split-Teil bitte nur auskommentieren). Wie muß denn das Makro geändert werden?

Tabelle1

	A	B	C	D	E	F	G
1
2		Produktname
3
4					Component list
5			Source Data From:		Lieferant
6			Project:		Strasse
7			Variant:		PLZ Ort
8
9			Report Date:	26.02.2015	13:36:39
10			Print Date:	09.11.2015	11:40:12
11		#	Designator	Part Field 1	Footprint
12		1	C1	150uF 35V ZLG 8x11.5 Rubycon	Keramik RM5_d8
13

verbundene Zellen

B2:F2

E12:F12

E13:F13

verwendete Formeln
Zelle	Formel	Bereich	N/A
D10	=HEUTE()
E10	=JETZT()
B12:B13	=WENN(C12<>"";ZEILE(B12)-ZEILE($B$11);"")

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

Sub WerteTrennen(oWsQ As Worksheet, oWsZ As Worksheet, rngZ As Range)  'MitFeldvariablen_Uwe() 
 Dim lngSpalte As Long, lngZeileQ As Long, lngZeileZ As Long
 Dim lngBauteile As Long, lngLetzteZeile As Long
 Dim varBauteile As Variant, varQ As Variant, varV As Variant, varZ As Variant
 Const strV As String = " | "
 
 With oWsQ
   'letzte belegte Zeile in Spalte A (1) 
   lngLetzteZeile = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
   
   'Quelltabelle in Variable einlesen 
   varQ = .Range("A7:J" & lngLetzteZeile).Value
 End With
 
 'Schleife für Bauteilesummierung 
 For lngZeileQ = 1 To Ubound(varQ)
   If Not IsNumeric(varQ(lngZeileQ, 7)) Or varQ(lngZeileQ, 7) = "" Then
     lngBauteile = lngBauteile + 1
   Else
     lngBauteile = lngBauteile + varQ(lngZeileQ, 7)
     varQ(lngZeileQ, 7) = 1
   End If
 Next lngZeileQ
 
 'Variablen für die Rückgabe entsprechend der Bauteileanzahl dimensionieren 
 Redim varV(1 To lngBauteile, 1 To 2)
 Redim varZ(1 To lngBauteile, 1 To Ubound(varQ, 2))
 
 'Schleife für das Umschaufeln der Daten 
 For lngZeileQ = 1 To Ubound(varQ)
   varBauteile = Split(varQ(lngZeileQ, 3), ",")
   For lngBauteile = 0 To Ubound(varBauteile)
     lngZeileZ = lngZeileZ + 1
     varZ(lngZeileZ, 1) = lngZeileZ
     varZ(lngZeileZ, 2) = varQ(lngZeileQ, 2)
     varZ(lngZeileZ, 3) = Trim(varBauteile(lngBauteile))
     varV(lngZeileZ, 1) = lngZeileZ
     varV(lngZeileZ, 2) = varZ(lngZeileZ, 3)
     For lngSpalte = 4 To Ubound(varZ, 2)
       varZ(lngZeileZ, lngSpalte) = varQ(lngZeileQ, lngSpalte)
       varV(lngZeileZ, 2) = varV(lngZeileZ, 2) & strV & varZ(lngZeileZ, lngSpalte)
     Next lngSpalte
   Next lngBauteile
 Next lngZeileQ
 
 'Zurückschreiben der Zielvariable in Zieltabelle 
 oWsQ.Range("B2:C5").Copy oWsZ.Range("B2")
 With oWsZ.Cells(7, 1).Resize(Ubound(varZ, 1), Ubound(varZ, 2))
   .Value = varZ
   .EntireColumn.AutoFit
 End With
 rngZ.Resize(Ubound(varV, 1), Ubound(varV, 2)).Value = varV
 rngZ.Resize(Ubound(varV, 1) - 1, 1).Offset(1, 2).Formula = rngZ.Offset(0, 2).Formula
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

[Kuwer]

Hallo Ralf,

dann vielleicht so?:

Sub WerteTrennen2(oWsQ As Worksheet, oWsZ As Worksheet, rngZ As Range)  'MitFeldvariablen_Uwe() 
Dim lngSpalte As Long, lngZeileQ As Long, lngZeileZ As Long
Dim lngBauteile As Long, lngLetzteZeile As Long
Dim varBauteile As Variant, varQ As Variant, varV As Variant, varZ As Variant
Const strV As String = " | "

With oWsQ
'   'letzte belegte Zeile in Spalte A (1) 
'   lngLetzteZeile = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) 
  
  'letzte belegte Zeile in Spalte B (1) 
  lngLetzteZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
  
  'Quelltabelle in Variable einlesen 
'   varQ = .Range("A7:J" & lngLetzteZeile).Value 
  varQ = .Range("B7:D" & lngLetzteZeile).Value
End With

' 'Schleife für Bauteilesummierung 
' For lngZeileQ = 1 To UBound(varQ) 
'   If Not IsNumeric(varQ(lngZeileQ, 7)) Or varQ(lngZeileQ, 7) = "" Then 
'     lngBauteile = lngBauteile + 1 
'   Else 
'     lngBauteile = lngBauteile + varQ(lngZeileQ, 7) 
'     varQ(lngZeileQ, 7) = 1 
'   End If 
' Next lngZeileQ 

lngBauteile = 1
' 'Variablen für die Rückgabe entsprechend der Bauteileanzahl dimensionieren 
' ReDim varV(1 To lngBauteile, 1 To 2) 
' ReDim varZ(1 To lngBauteile, 1 To UBound(varQ, 2)) 
' 
' 'Schleife für das Umschaufeln der Daten 
' For lngZeileQ = 1 To UBound(varQ) 
'   varBauteile = Split(varQ(lngZeileQ, 3), ",") 
'   For lngBauteile = 0 To UBound(varBauteile) 
'     lngZeileZ = lngZeileZ + 1 
'     varZ(lngZeileZ, 1) = lngZeileZ 
'     varZ(lngZeileZ, 2) = varQ(lngZeileQ, 2) 
'     varZ(lngZeileZ, 3) = Trim(varBauteile(lngBauteile)) 
'     varV(lngZeileZ, 1) = lngZeileZ 
'     varV(lngZeileZ, 2) = varZ(lngZeileZ, 3) 
'     For lngSpalte = 4 To UBound(varZ, 2) 
'       varZ(lngZeileZ, lngSpalte) = varQ(lngZeileQ, lngSpalte) 
'       varV(lngZeileZ, 2) = varV(lngZeileZ, 2) & strV & varZ(lngZeileZ, lngSpalte) 
'     Next lngSpalte 
'   Next lngBauteile 
' Next lngZeileQ 

' 'Zurückschreiben der Zielvariable in Zieltabelle 
' oWsQ.Range("B2:C5").Copy oWsZ.Range("B2") 
' With oWsZ.Cells(7, 1).Resize(UBound(varZ, 1), UBound(varZ, 2)) 
'   .Value = varZ 
'   .EntireColumn.AutoFit 
' End With 
' rngZ.Resize(UBound(varV, 1), UBound(varV, 2)).Value = varV 
' rngZ.Resize(UBound(varV, 1) - 1, 1).Offset(1, 2).Formula = rngZ.Offset(0, 2).Formula 

'Zurückschreiben der Quellvariable in Zieltabelle 
oWsQ.Range("B2:C5").Copy oWsZ.Range("B2")
With oWsZ.Cells(7, 1).Resize(Ubound(varQ, 1), Ubound(varQ, 2))
  .Value = varQ
  .EntireColumn.AutoFit
End With
rngZ.Resize(Ubound(varQ, 1), Ubound(varQ, 2)).Value = varQ
rngZ.Resize(Ubound(varQ, 1) - 1, 1).Offset(1, 2).Formula = rngZ.Offset(0, 2).Formula
End Sub

Gruß Uwe