Dopeltewerte

Question

hallo ich brauche mal eure hilfe bitte !!!

Ich habe eine exceltabelle ( Lagertabelle )
in der ich doppelte Werte zusammen zählen möchte und die über
flüsigen dan löschen.

also ich gebe meine daten wie folgt ein.
z.b.
A B C D bis L
3 Artikel Größe Stück ........

4 Alu 3000x1500x2 20
5 V2a 3000x1500x2 15
6 Alu 3000x1500x2 8
7
.
.
meine Werte gebe ich von A4 bis L4 von links nach rechts ein.
jetzt kann es vorkommen das ich doppelte werte habe aber diese möchte ich zusammen zählen ( A4 Alu 3000x1500x2 sind dan 28 Stück und die A6 bis L6 kann dan gelöscht werden.

kann mir dabei vieleicht jemand helfen bitte...?!

gruß nero022







.

Answer 1

Hallo,

seh dir mal die Datei an

www.file-upload.net/download-2087275/test-02-1-.xls.html

dort Makro 4, sollte in etwa deinen vorstellungen entsprechen.

In den Spalten j und k habe ich die Formel etwas geändert die anzfangszelle der Formel mit $ festgesetzt.

Gruß

Helmut

Answer 2

Hallo Helmut !!!

Danke erst mal für deine mühe....!!!

Habe das Makro mal getestet,es klapt auch das sehe ich an der liste !!!

aber sie hört einfach nicht auf ihre berechnungen auszuführen woran kann das liegen ??????

und wenn ich die suche verkleiner will von A65536 auf A300
geht es leider gar nicht mehr ...?

gruß nero022

Answer 3

Hallo,

da du 3000 Zeilen mit Werten, in der Beispieltabelle meist 0, belegt hast, dauert das schon eine Weile. Da ich die Zusammenhänge so genau nicht nachvollziehen kann, kann ich dir im Moment keine bessere Lösung anbieten.

Gruß

Helmut

Answer 4

hi all ^^

ein solch massiver zugriff auf zellen ist nicht unbedingt noetig

nehmen wie nur einmal an das eine zelle 40 funktionen hat, dann tastet ihr zur zeit 171 798 691 840 attribute ab

versucht doch einmal die daten in ein array zu legen und abzufragen und gegebenfalls zu aendern und in einem rutsch zurueckzuschreiben

gruss nighty

Answer 5

Hallo !!!!

wie meinst du das in einer Arrey ??

also das habe ich noch nie gemacht...!

kannst du mir vieleicht dabei helfen ...?

aber erst ein mal danke an euch beide das ihr euch damit beschäfticht..!!

gruß nero

Answer 6

hi nero ^^

probier das mal ^^

gruss nighty

Option Explicit
Sub Einfuegen()
Dim SpalteA() As Variant, SpalteAneu() As Variant
Dim ArrIndex0 As Long, ArrIndex1 As Long, SpA1zeilen As Long, SpA2zeilen As Long
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
SpA1zeilen = Cells(Rows.Count, 1).End(xlUp).Row
SpalteA() = Range("A1:L" & SpA1zeilen)
Range("A1:L" & SpA1zeilen) = ""
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
SpA2zeilen = Cells(Rows.Count, 1).End(xlUp).Row
SpalteAneu() = Range("A1:L" & SpA2zeilen)
For ArrIndex0 = 1 To SpA2zeilen
For ArrIndex1 = 1 To SpA1zeilen
If SpalteA(ArrIndex1, 1) = SpalteAneu(ArrIndex0, 1) And SpalteA(ArrIndex1, 1) <> "" And SpalteAneu(ArrIndex0, 1) <> "" Then
SpalteA(ArrIndex1, 12) = SpalteA(ArrIndex1, 12) + SpalteAneu(ArrIndex0, 12)
End If
Next ArrIndex1
Next ArrIndex0
Range("A1:L" & SpA1zeilen & SpA2zeilen) = ""
Range("A1:L" & SpA1zeilen) = SpalteA()
End Sub

Answer 7

hallo nighty !

danke für deine hilfe , aber leider klapt es nicht.
habe das makro in meine tabelle eingefügt und gestartet, dan hat es bis zu fünf minuten gedauert bis was passiert ist.
er hat mir nur die zellen von A2 bis A3000 ausgeblendet..

denke mal das es wohl nicht so einfach ist was ich vor habe,vieleicht solte ichg mir da was anderres überlegen.

gruß nero022

Answer 8

hi all ^^

schick mir eine musterdatei

an oberley@t-online.de mit eindeutigen betreff bitte

und wieder das leidige theme der emailadresse

achja ,ich liebe spam,also was solls

gruss nighty

Answer 9

hi nero ^^

laufzeit !!!

gefuellte spalten, A bis L
gefuellte zeilen 65 550
laufzeit ,unter 1 sekunde

das geheimnis wird sich erst preisgeben bei eine mustertabelle ^^

gruss nighty

Answer 10

hi nero ^^

meine vermutung
eine oder mehrere ereignisauslöser

daher eine neue variante,die einige ereignisse zur laufzeit ausschaltet

gruss nighty

Option Explicit
Sub Einfuegen()
Call EventsOff
Dim SpalteA() As Variant, SpalteAneu() As Variant
Dim ArrIndex0 As Long, ArrIndex1 As Long, SpA1zeilen As Long, SpA2zeilen As Long
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
SpA1zeilen = Cells(Rows.Count, 1).End(xlUp).Row
SpalteA() = Range("A1:L" & SpA1zeilen)
Range("A1:L" & SpA1zeilen) = ""
Columns("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
SpA2zeilen = Cells(Rows.Count, 1).End(xlUp).Row
SpalteAneu() = Range("A1:L" & SpA2zeilen)
For ArrIndex0 = 1 To SpA2zeilen
For ArrIndex1 = 1 To SpA1zeilen
If SpalteA(ArrIndex1, 1) = SpalteAneu(ArrIndex0, 1) And SpalteA(ArrIndex1, 1) <> "" And SpalteAneu(ArrIndex0, 1) <> "" Then
SpalteA(ArrIndex1, 12) = SpalteA(ArrIndex1, 12) + SpalteAneu(ArrIndex0, 12)
Exit For
End If
Next ArrIndex1
Next ArrIndex0
Range("A1:L" & SpA2zeilen) = ""
Range("A1:L" & SpA1zeilen) = SpalteA()
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub