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.
Vielen Dank für deine Hilfe schon mal vorab!
Hallöchen,
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
Hallo Andre,
ich habe es jetzt mal ausprobiert und ich bekomme folgende Meldungen
[
Bild bitte so als Datei hochladen: Klick mich!]
Hallöchen,
das Blatt mit den Daten muss das aktive sein und wie gesagt, Du musst manuell eine Tabelle2 einfügen.
Moin Andre, es tut mir leid, aber ich bin leider kein Experte im Excel.
Was meinst Du mit aktiv und manuell zweites Tabellenblatt einfügen?
Beste Grüße
Reiko
Hallöchen,
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.
Moin nochmal,
leider klappt das so immer noch nicht.
Ich habe Dir nochmal meine Datei angehängt.
Beste Grüße
Reiko
Him,
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.