Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
452to456
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
452to456
452to456
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kontrolle ob doppelte Werte eingegeben

Kontrolle ob doppelte Werte eingegeben
13.07.2004 10:24:42
Gernot
Hallo liebe Community!
Im Voraus ein herzliches Dankeschön für die tollen Lösungen die ihr mir immer in so kurzer Zeit liefert und mir damit stundenlanges Grübeln erspart!
Habe derzeit folgendes Problem - möchte in einem Excelblatt einen code einfügen, dass Excel bei Druck auf Button in dem sheet kontrolliert ob Werte in bestimmten Splaten gleich sind (A, B). Ist dies der Fall soll die Spalte A und B nur einmal dargestellt werden, der Zahlenwert der Spalte (C) aller gleichen Werte soll aber aufsummiert werden.
Bsp.
Spalte
A; B; C;
12; 10; 20;
13; 14; 11;
13; 14; 11;
20; 3; 7;
12; 10; 20;
In diesem Fall sollte Excel erkennen dass die Werte der Spalte A und B in den Zeilen 2 und 3, die Spalte A und B in der Zeile 1 und 5 gleich sind.
Als Ergebnis sollte Excel die Zeile 2 und 3 in einem neuen Tabellenblatt zusammenfassen und dabei die Werte der Spalte C bei den gleichen Spalten A und B aufaddieren.
Spalte
A; B; C;
12; 10; 40;
13; 14; 22;
20; 3; 7;
LG Gernot

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kontrolle ob doppelte Werte eingegeben
IngoG
Hallo Gernod,
folgendes Macro sollte es tun :

Sub doppler_add()
Dim i&, j&
With Sheets("tabelle1")
For i = .Range("a65536").End(xlUp).Row To 2 Step -1
For j = 2 To i - 1
If .Cells(i, 1) = .Cells(j, 1) And .Cells(i, 2) = .Cells(j, 2) Then
.Cells(j, 3) = .Cells(i, 3) + .Cells(j, 3)
.Cells(i, 1).EntireRow.Delete
End If
Next j
Next i
End With
End Sub

Gruß Ingo
PS eine Rückmeldung wäre nett...
AW: Kontrolle ob doppelte Werte eingegeben
Gernot
Hallo Ingo!
Hab gerade getestet - herzlichen Dank - funktioniert einwandfrei!!!! Kann man es noch dahingehend umwandeln, dass die doppelten Eingaben auf dem ersten Tabellenblatt bestehen bleiben und die Zusammenfassung auf dem zweiten Tabellenblatt dargestellt wird?
LG Gernot
Anzeige
AW: Kontrolle ob doppelte Werte eingegeben
Gernot
Hallo Ingo!
Will dich nicht nerven, aber hätte da noch eine Zusatzfrage.
Wie muss ich den code adaptieren, wenn ich kontrollieren will ob A und B Spalte oder A und C Spalte gleich sind und das Ergebnnis in Spalte D aufsummiert werden soll?
LG Gernot
AW: Kontrolle ob doppelte Werte eingegeben
IngoG
Hallo Gernod,
bin mir nicht wirklich klar darüber wie der vergleich aussehen soll...
stell doch einfach eine kleine Testdatei mit ausgangsdaten und ergebnis ins netz.
Gruß Ingo
AW: Kontrolle ob doppelte Werte eingegeben
Gernot
Hallo Ingo!
Habe eine Testdatei mit Ausgangslage und Ergebnis auf dem Server bereitgestellt.
Herzlichen Dank
Gernot
https://www.herber.de/bbs/user/8457.xls
Anzeige
neues Macro
IngoG
Hallo Gernot,
habe das macro jetzt mal abgeändert.
zunächt erzeuge ich einfach eine kopie der originaldaten in "Ergebnis" und lasse das Macro dann auf die kopie laufen... (Vorsicht! "Ergebnis" wird am Anfang des Macros immer komplett gelöscht!!!)
in Deinen Testdaten ist mir dabei aufgefallen, dass Du einmal 70.000 nicht addiert hast obwohl mE der Schlüssel 2 Reihen vorher schon einmal vorkommt...
zu testzwecken habe ich in spalte G einfach die anzahl der zusammengeschobenen Sätze eingetragen (wenn es doppelte gab sonst leer)
die Zeile kannst Du evt wieder rausnehmen...
Wenn Du Fragen haben solltest, melde Dich einfach nochmal.
Gruß Ingo
PS eine Rückmeldung wäre nett...
Hier nun der Macro-code:
Option Explicit

Sub doppler_add()
Dim i&, j&
Application.ScreenUpdating = False
With Sheets("Ergebnis")
.Cells.Delete
Sheets("Tabellenblatt1").Cells.Copy
.Paste Destination:=.Range("A1")
For i = .Range("a65536").End(xlUp).Row To 1 Step -1
For j = 1 To i - 1
If .Cells(i, 1) = .Cells(j, 1) And _
((.Cells(i, 3) = .Cells(j, 3) And Not IsEmpty(.Cells(i, 3))) _
Or (.Cells(i, 4) = .Cells(j, 4) And Not IsEmpty(.Cells(i, 4)))) Then
.Cells(j, 6) = .Cells(i, 6) + .Cells(j, 6)
' *****************nächste Zeile kann wieder raus!!! nur zum Testen!!!
.Cells(j, 7) = Application.WorksheetFunction.Max(1, .Cells(j, 7)) + 1
.Cells(i, 1).EntireRow.Delete
End If
Next j
Next i
End With
Application.ScreenUpdating = False
End Sub

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige