14.05.2018, 15:48 (Dieser Beitrag wurde zuletzt bearbeitet: 14.05.2018, 15:54 von WillWissen.
Bearbeitungsgrund: Formatierung
)
Hallo Andre,
hier habe ich nochmal meine aktuelle Problematik geschildert. Es hat sich noch etwas in der Tabellenreihenfolge geändert.
Wenn Inhalt Spalte F gleich + Inhalt Spalte H gleich, dann Inhalte aus Spalte C untereinander zusammen in eine Zelle fügen. Dazu Inhalte aus Spalte L+M+N+O jeweils zusammen addieren und auch in eine Zelle. Dazu Inhalte aus Spalte P auch zusammen in eine Zelle untereinander Rest entfernen so das nur ein Datensatz mit allen zusammengefügten Daten bleibt.
füge bitte mal eine Tabelle2 hinzu und probiere diesen Code:
Code:
Sub DatenZusammenFassen() 'Variablendeklarationen Dim arrDaten, arrTmp 'Daten in Array nehmen arrDaten = ActiveSheet.UsedRange 'temp-Array rediensionieren ReDim arrTmp(1 To UBound(arrDaten, 1), 1 To 16) 'Ueberschriften uebernehmen For icnt = 1 To 16 arrTmp(1, icnt) = arrDaten(1, icnt) Next 'Arrayindexzaehler setzen icnt2 = icnt2 + 1 'Schleife ueber alle DatenZeilen For icnt1 = 2 To UBound(arrDaten, 1) 'Arrayindexzaehler hochsetzen icnt2 = icnt2 + 1 'Wenn die vorhergehenden Daten F und G uebereinstimmen, dann If arrDaten(icnt1, 6) = arrDaten(icnt1 - 1, 6) And arrDaten(icnt1, 8) = arrDaten(icnt1 - 1, 8) Then 'Daten L bis P uebernehmen 'Schleife ueber die Felder For icnt = 12 To 15 'Inhalt addieren arrTmp(icnt2 - 1, icnt) = arrTmp(icnt2 - 1, icnt) + arrDaten(icnt1, icnt) 'Ende Schleife ueber die Felder Next 'Inhalt Feld in Spalte P hinzufuegen arrTmp(icnt2 - 1, 16) = arrTmp(icnt2 - 1, 16) & ";" & arrDaten(icnt1, 16) 'Arrayindexzaehler runtersetzen fuer eventuelle naechste uebernahme icnt2 = icnt2 - 1 'oder wenn sie nicht uebereinstimmen Else 'Zeile uebernehmen 'Schleife ueber alle Felder der zeile For icnt = 1 To 16 'Inhalt uebernehmen arrTmp(icnt2, icnt) = arrDaten(icnt1, icnt) 'Ende Schleife ueber alle Felder der zeile Next 'Ende Wenn die vorhergehenden Daten F und G uebereinstimmen, dann End If 'Ende Schleife ueber alle DatenZeilen Next Sheets("Tabelle2").Cells(1, 1).Resize(UBound(arrTmp, 1), 16).Value = arrTmp End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
das eine muss das angeklickte sein, also das, auf dem Du was eingeben kannst, und das andere musst Du von Hand hinzufügen. einfach unten auf das entsprechende Symbol drücken.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
auch mit Andrés Originalcode und Umbenennen des zusätzlichen Blattes in Tabelle2 kommt die Fehlermeldung "Index außerhalb des gültigen Bereichs" und dies arrTmp(1, icnt) = arrDaten(1, icnt) ist gelb markiert.
