14.05.2018, 14:48 (Dieser Beitrag wurde zuletzt bearbeitet: 14.05.2018, 14: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.
