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

hi nero ^^

ereignisausschaltung spart mindestens ca auch eine zehntel sekunde ein ^^

nach subjektiven zeitmessungen :-))

gruss nighty

Answer 2

hi all und nero ^^

momentane zeitmessung

bei 786600 gefuellten zellen

0,546875 sek

interessant waere hier noch eine dynamische halbierung des zu durch suchenden bereiches
mit 1000 sich wiederholbaren halbierungen erreichte ich noch zusaetzlich eine ersparnis von

ca 0,123365 sek

wobei hier die ersparte zeit umso groesser ist wie die datenmenge zunimmt,der faktor 1000 ist dann zu klein bzw hier muesste man sich mal gedanken ueber eine funktion machen,die den faktor optimal bestimmt anhand der jeweiligen datenmengen

gruss nighty

Answer 3

Hallo nighty !!!

sorry konnte mich nicht ehr melden !!!
aber danke schon mal das du mir noch weiter helfen willst !!!

habe dir gerade eine e-mail geschrieben mit einer test datei !!

gruß nero022.

Answer 4

hi all ^^

stand zur zeit :-))

durch verkettete daten ist ein array nicht möglich

genauso zellen die verknuepfungen enthalten aber nicht genutzt werden ,verlangsamt sich die laufzeit enorm

ich experimentiere noch bisl ^^

generell ist zu sagen das verbundene zellen wie auch verkettete daten in vb probleme bereiten durch schlechte umsetzung der syntax

gruss nighty

Answer 5

hi all ^^

es lag nicht an den oben beschriebenen vermutungen,es war ein anderer fehler :-(

das makro funktioniert zwar,aber die laufzeit ist grottenschlecht ^^

*gruebel*

ich werd die 2 schleife verbannen muessen ^^

ich meld mich wieder :-))

hier das grottenschlechte makro *arghhh*
ein annehmbares makro folgt ^^

Sub Einfuegen()
Call EventsOff
Dim Index As Long
Dim Uebergabe As Long
Dim Schalter As Boolean
Dim SpalteA() As Variant
Dim SpalteAneu() As Variant
Dim ArrIndex0 As Long
Dim ArrIndex1 As Long
Dim SpA1zeilen As Long
Index = 6
SpA1zeilen = Cells(Rows.Count, 6).End(xlUp).Row
SpalteA() = Range("A1:L" & SpA1zeilen)
Range("A7:L" & SpA1zeilen).Clear
SpalteAneu() = Range("A1:L" & SpA1zeilen)
For ArrIndex0 = 7 To SpA1zeilen
For ArrIndex1 = 7 To SpA1zeilen
If SpalteA(ArrIndex0, 6) = SpalteAneu(ArrIndex1, 6) And SpalteA(ArrIndex0, 6) <> "" Then
SpalteAneu(ArrIndex1, 12) = SpalteAneu(ArrIndex1, 12) + SpalteA(ArrIndex0, 12)
Schalter = True
Exit For
End If
Next ArrIndex1
If Schalter = False And SpalteA(ArrIndex0, 6) <> "" And Mid(SpalteA(ArrIndex0, 6), 1, 1) <> "0" Then
Index = Index + 1
For Uebergabe = 1 To 12
SpalteAneu(Index, Uebergabe) = SpalteA(ArrIndex0, Uebergabe)
Next Uebergabe
End If
Schalter = False
Next ArrIndex0
Range("A1:L" & SpA1zeilen) = SpalteAneu()
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

gruss nighty

Answer 6

hallo nighty !!!

habe das makro mal versucht es klappt auch !!!! aber leider löscht es mir auch die formeln
aus meinen zellen die ich aber noch benötige !!!
da es ja eine material liste ist und sie stetich erweitert wird,benötige ich die formeln !!!

aber danke das du dir so viel zeit nimst !!!

guß nero022

Answer 7

hi nero ^^

das war mir auch schon aufgefallen mit den formeln :-))

die laufzeit ärgert mich erstmal,das bei strings solch ein massiver unterschied zu meinen getesteten probelauf mit integer werten ist hatte ich ich nicht erwartet

ich experimentiere noch :-)

gruss nighty

Answer 8

hi nero ^^

neue variante mit zufriedenstellender laufzeit ,aber die ausgabe ist tabelle2

eine darstellung in der quelltabelle gestaltet sich durch formel erhalt als enorme bremse der laufzeit,die schon bei 3000 zeilen nicht akzeptabel ist(durch loeschen von zeilen verursacht)

dein formelindex wird auch zerstueckelt

ich experimentiere noch ^^

gruss nighty

Option Explicit
Sub Einfügen()
Dim ArrDic As Object
Dim SpAufnahme As Long
Dim ZeilenZaehler As Integer
Dim IndexZaehler As Long
Dim ArrIn As Variant
Dim ArrOut() As Variant
Set ArrDic = CreateObject("Scripting.Dictionary")
ArrIn = Range("A7:L" & Cells(Rows.Count, 6).End(xlUp).Row)
For SpAufnahme = 1 To UBound(ArrIn)
If Not ArrDic.Exists(ArrIn(SpAufnahme, 6)) Then
IndexZaehler = IndexZaehler + 1
ReDim Preserve ArrOut(1 To UBound(ArrIn, 2), 1 To IndexZaehler)
For ZeilenZaehler = 1 To UBound(ArrIn, 2)
ArrOut(ZeilenZaehler, IndexZaehler) = ArrIn(SpAufnahme, ZeilenZaehler)
Next
End If
ArrDic(ArrIn(SpAufnahme, 6)) = ArrDic(ArrIn(SpAufnahme, 6)) + ArrIn(SpAufnahme, 12)
Next
If IndexZaehler = 0 Then Exit Sub
For SpAufnahme = 1 To UBound(ArrOut, 2)
ArrOut(12, SpAufnahme) = ArrDic(ArrOut(6, SpAufnahme))
Next
Worksheets("Tabelle2").Range("A2").Resize(UBound(ArrOut, 2), UBound(ArrOut)) = WorksheetFunction.Transpose(ArrOut)
Worksheets("Tabelle2").Rows(UBound(ArrIn, 2) - 6).Delete Shift:=xlUp
Set ArrDic = Nothing
End Sub

Answer 9

hi nero ^^

ich werd die tage mal deine formeln durch ereignissteuerung ersetzen,da sich zur zeit formeln und automatismus gegenseitig behindern

gruss nighty