Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Zeileninahlte löschen wenn Wert doppelt

VBA Zeileninahlte löschen wenn Wert doppelt
09.04.2017 17:01:57
Björn
Hallo zusammen,
in der Vergangenheit konntet ihr mir bereits sehr helfen. Ich habe ein neues Problem. Gerne würde ich meinen Onlineshop mit neuen Produkten bestücken. Problem dabei ist, der Shop nimmt nur ein bestimmtes "Format" an.
https://www.herber.de/bbs/user/112751.xlsx ist die Beispieldatei.
In Spalte A stehen die Artikelnummern.
Wenn diese Nummern doppelt oder auch mehrfach vorhanden sind, siehe z.B. A2 - A4 oder A16 - A18, soll in der ersten Zeile alle Werte (C-AG) erhalten bleiben. In der nächsten Zeile, wenn die Artikelnummer erneut vorkommt, die Werte C-AG gelöscht werden.
Jetzt wo ich es schreibe merke ich, wie schwer es zu erklären ist :-)
Beispiel für die Zeilen 2, 3, 4:
Zeile 2 soll vollständig bestehen bleiben A2 - AG2
Zeile 3 sollen die Werte von C3 - AG3 gelöscht werden
Zeile 4 sollen die Werte von C4 - AG4 gelöscht werden
Zeile 5 soll, da es eine neue Artikelnummer ist bestehen bleiben A5-AG5
Zeile 6 sollen die Werte von C6 - AG6 gelöscht werden
Zeile 7 sollen die Werte von C7 - AG7 gelöscht werden
u. s. w.
Mit meinen Kenntnissen schaffe ich es nicht das umzusetzen, vielleicht könnt ihr mir helfen.
Vielen lieben Dank
Björn

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Zeileninahlte löschen wenn Wert doppelt
09.04.2017 18:53:32
GraFri
Hallo Björn
Variante mit Dictionary.
Option Explicit
Sub Löschen_speziell()
Dim myArr As Variant
Dim objDict As Object
Dim objWks As Worksheet
Dim n As Long, z As Long
Set objWks = ThisWorkbook.Worksheets("Tabelle1")
Set objDict = CreateObject("Scripting.Dictionary")
' Wertebereich aus Tabelle einlesen
With objWks
myArr = Application.Transpose(.Range([A2], .Cells(Rows.Count, "A").End(xlUp)))
End With
For n = 1 To UBound(myArr, 1)
If objDict.Exists(myArr(n)) Then
z = n + 1
objWks.Range("C" & z & ":AG" & z).ClearContents
Else
objDict(myArr(n)) = 0
End If
Next
End Sub
mfg, GraFri
Anzeige

376 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige