Office: vor dem Kopieren auf doppelte Datensätze prüfen!!!

StevEiserman · 27. September 2016

Hallo,

ich kopiere per Makro von einer Tabelle in die andere gewünschte Datensätze, was auch gut funktioniert mit der Zeit wird die Datenmänge so groß, das ich auch ungewollt doppelte Datensätze habe!!!
Jetzt möchte ich gerne vorab die Zelle "A1" in Tabelle "Eingabe" mit
der Spalte "A:A" der "Tabelle1" (Ziel) abgleichen vor dem kopieren, sollte
hier der Datensatz doppelt sein würde ich gerne per MsgBox ausgeben,
das der Wert doppelt ist (nicht kopiert wird) und in welcher Zeile (zur Kontrolle)

Anbei mein einfacher Code:

Code:

Sub kopieren()
Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Range("A1").Select

Range("BY2:CM2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Tabelle1").Select
Range("A1048576").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Sheets("Tabelle1")
lr = .Cells(Rows.Count, "O").End(xlUp).Row + 1

'Range("O1048576").End(xlUp).Offset(1, 0).Select
.Range("O" & lr) = Environ("username")
.Range("P" & lr) = Application.Version
.Range("Q" & lr) = Environ("computername")
.Range("R" & lr) = Application.Build
.Range("S" & lr) = ListIPs
Sheets("Eingabe").Select
Range("A1").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("Eingabe").Select
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

rastrans · 28. September 2016

Hallo,

ich habe versucht den Code zu schreiben, bin aber völlig durcheinander, von wo nach wo du etwas kopieren möchtest. Ohne Beispieldatei ist dein Code schwer zu verstehen!

Aber vielleicht hilft dir der Code schon mal.

Viele Grüße
rastrans Code:

Option Explicit

Sub Suchen()
Dim lngZeile As Long
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim rng As Range

Set wsSource = Worksheets("Tabelle1")
Set wsDestination = Worksheets("Tabelle2")

'springe in die letzte beschriebene Zelle in Spalte A von Tabelle1
lngZeile = wsSource.Cells(Rows.Count, 1).End(xlUp).Row

'suche in Tabelle2 nach dem Inhalt
Set rng = wsDestination.Columns(1).Find(What:=wsSource.Cells(lngZeile, 1).Value, LookAt:=xlWhole)
'Wenn nichte gefunden...
If rng Is Nothing Then
'... dann schreibe einen Text.
MsgBox "Daten nicht in Tabelle2 vorhanden!"
Else
'... wenn doch, dann sag mal in welcher Zeile
MsgBox "Gefunden in Zeile " & rng.Row
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

StevEiserman · 28. September 2016

Hallo rastrans,

ja ich weis mein VBA-Kenntnisse sind schlimmer als eine Fremdsprache.
Also ich gebe in der Tabelle "Eingabe" "A1" einen Artikel ein. Über
Formeln(Sverweise) werden dann die nötigen Daten gezogen, die dann
angepasst (für Tabelle1) in ("BY2:CM2") stehen.
Diese sollen dann kopiert werden wenn Tabelle "Eingabe" "A1"
Tabelle1 A:A (hier steht die Artikelnummer).
Ich hoffe ich konnte ein bischen entwirren???!!
Deinen Code habe ich versucht anzupassen ist mir aber nicht gelungen

Danke+
Gruß
Stev

rastrans · 29. September 2016

Code:

Sub kopieren()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim rng As Range
Dim lngZeile As Long

Application.Calculation = xlCalculationManual

Set wsSource = Worksheets("Eingabe")
Set wsDestination = Worksheets("Tabelle1")

Set rng = wsDestination.Columns(1).Find(What:=wsSource.Range("A1").Value, LookAt:=xlWhole)
If rng Is Nothing Then
With wsDestination
lngZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
wsSource.Range("BY2:CM2").Copy Destination:=.Cells(lngZeile, 1)
.Range("O" & lngZeile) = Environ("username")
.Range("P" & lngZeile) = Application.Version
.Range("Q" & lngZeile) = Environ("computername")
.Range("R" & lngZeile) = Application.Build
.Range("S" & lngZeile) = ListIPs
End With
Else
wsDestination.Select
wsDestination.Rows(rng.Row).Select
MsgBox "Daten bereits vorhanden!"
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

StevEiserman · 29. September 2016

Hallo rastrans,

Vielen Dank wir haben es fast, da es sich bei den kopierten
Daten um Formeln handeltt, dürfen also nur Werte übergeben (kopiert werden)

*Smilie

rastrans · 29. September 2016

Code:

Sub kopieren()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim rng As Range
Dim lngZeile As Long
Dim arr

Application.Calculation = xlCalculationManual

Set wsSource = Worksheets("Eingabe")
Set wsDestination = Worksheets("Tabelle1")

Set rng = wsDestination.Columns(1).Find(What:=wsSource.Range("A1").Value, LookAt:=xlWhole)
If rng Is Nothing Then
With wsDestination
lngZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
arr = wsSource.Range("BY2:CM2")
.Range(Cells(lngZeile, 1).Address, Cells(lngZeile, UBound(arr, 2)).Address) = arr
.Range("O" & lngZeile) = Environ("username")
.Range("P" & lngZeile) = Application.Version
.Range("Q" & lngZeile) = Environ("computername")
.Range("R" & lngZeile) = Application.Build
.Range("S" & lngZeile) = ListIPs
End With
Else
wsDestination.Select
wsDestination.Rows(rng.Row).Select
MsgBox "Daten bereits vorhanden!"
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

StevEiserman · 29. September 2016

Hallo rastrans,

Vielen Dank, genau das wars!!!!
Du hast mir sehr geholfen!!!!!

Gruß
Stev

Office: vor dem Kopieren auf doppelte Datensätze prüfen!!!

vor dem Kopieren auf doppelte Datensätze prüfen!!!

vor dem Kopieren auf doppelte Datensätze prüfen!!!

vor dem Kopieren auf doppelte Datensätze prüfen!!!

vor dem Kopieren auf doppelte Datensätze prüfen!!! - Similar Threads - Kopieren doppelte Datensätze

"Bedingte Formatierung" durch kopieren und verschieben "zerpflückt"?

Makro Zip-Datei von Webseite runterladen, auspacken, kopieren

VBA Zeilen kopieren mit Bedingung

VBA - Datensätze ans Ende einer anderen Tabelle kopieren

Formblatt kopieren und auffüllen

Daten kopieren ohne doppelte Werte

Kopieren mit Formatierung und doppelte Einträge