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