Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.06.2024 22:07:02
25.06.2024 21:01:55
25.06.2024 19:21:44
Anzeige
Archiv - Navigation
1824to1828
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
Inhaltsverzeichnis

VBA - Vereinfachung Doppelter Werte

VBA - Vereinfachung Doppelter Werte
14.04.2021 18:48:35
Sarah
Hallo zusammen,
Ich versuche mein Problem anhand eines Beispiels zu erklären. Es geht um eine VBA-Lösung.
Beispiel:
Ich habe eine Tabelle1 (siehe Bild unten) mit 3 Geräten, welche über eine Seriennummer eindeutig identifizierbar sind. Diese Geräte wurden von verschiedenen Personen mehrfach installiert und deinstalliert. Diese Installationen und Deinstallationen sind in der Tabelle1 protokolliert:

Nun möchte ich gerne in einem neuen Sheet im gleichen Workbook eine Tabelle2 mit folgenden Eigenschaften anhand Tabelle1 erstellen:
1. Jede Seriennummer ist einmal vertreten.
2. Zudem gilt pro Seriennummer:
- Das Installationsdatum ist das Installationsdatum an dem das Gerät das erste Mal installiert wurde.
- Das Deinstallationsdatum soll das Deinstallationsdatum aus der Zeile mit dem jüngsten Installationsdatum entsprechen (Dies kann entweder ein Datum beinhalten oder leer sein).
- Der Name soll dem Namen aus der Zeile mit dem jüngsten Installationsdatum entsprechen
Hier das Beispiel für Tabelle2:

Anmerkung zu Tabelle1:
Die Einträge sind nicht unbedingt chronologisch nach Installationsdatum sortiert (siehe Gerät mit Seriennr. 3)
Obwohl, das nicht so kompliziert klingt, habe ich keine Lösung erstellen können. Ich hoffe ihr könnt helfen...
Grüße
Sarah

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 18:53:21
Hajo_Zi
Hallo Sarah,
Du bist im falschen Forum. Bildbearbeitung ist ein anderes.
Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.
Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.
Ich baue keine Datei nach, die Zeit hat schon jemand investiert.
Schau mal hier
Eine hochgeladene Arbeitsmappe erhöht die Wahrscheinlichkeit, dass Du eine Lösung für Dein Problem erhältst.
Erstelle folglich bitte eine Demomappe, aus der deine Aufgabenstellung klar erkennbar ist und lade diese hoch.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten ändern. Schaue Datei
http://hajo-excel.de/gepackt/fremd/Datei_verschluesseln.zip
Falls Du den Download des Forums nicht benutzen möchtest beachte bitte: von unsicheren Servern file-upload lade ich keine Datei herunter (lt. Einschätzung meines Virenprogramms)
Das ist nur meine Meinung zu dem Thema.
GrußformelHomepage
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 19:08:00
Sarah
Hallo Hajo,
hier die Beispieldatei:
https://www.herber.de/bbs/user/145531.xlsx

Zudem hatte sich in der Abbildung von Tabelle2 ein Fehler eingeschlichen: Es muss bei Gerät 3 der Name "Boris" stehen. Dies ist in der Beispieldatei korrigiert.


Grüße
Sarah
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 20:01:05
Nepumuk
Hallo Sarah,
teste mal:
Option Explicit
Private Type DATA
Number As Long
Installation As Date
Deinstallation As Date
Name As String
End Type
Public Sub Extract()
Dim avntValues As Variant, vntItem As Variant
Dim lngCounter As Long, ialngIndex As Long
Dim strFirstAddress As String
Dim udtData() As DATA
Dim objDictionary As Object
Dim objCell As Range
With Tabelle1
avntValues = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value2
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
For Each vntItem In avntValues
If Not IsEmpty(vntItem) Then _
objDictionary.Item(Key:=vntItem) = vbNullString
Next
ReDim udtData(1 To objDictionary.Count)
For Each vntItem In objDictionary.Keys
lngCounter = lngCounter + 1
With udtData(lngCounter)
.Number = vntItem
.Installation = DateSerial(9999, 12, 31)
.Deinstallation = DateSerial(1900, 1, 1)
End With
Set objCell = .Columns(1).Find(What:=vntItem, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole)
strFirstAddress = objCell.Address
Do
With udtData(lngCounter)
.Installation = Application.Min(.Installation, objCell.Offset(0, 1).Value)
If (.Deinstallation  0 Then
.Deinstallation = objCell.Offset(0, 2).Value
.Name = objCell.Offset(0, 3).Value
End If
End With
Set objCell = .Columns(1).FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Next
End With
Set objDictionary = Nothing
Set objCell = Nothing
With Tabelle2
Call .Range(.Cells(2, 1), .Cells(.Rows.Count, 3)).ClearContents
For ialngIndex = 1 To lngCounter
.Cells(ialngIndex + 1, 1).Value = udtData(ialngIndex).Number
.Cells(ialngIndex + 1, 2).Value = udtData(ialngIndex).Installation
If udtData(ialngIndex).Deinstallation > 0 Then _
.Cells(ialngIndex + 1, 3).Value = udtData(ialngIndex).Deinstallation
.Cells(ialngIndex + 1, 4).Value = udtData(ialngIndex).Name
Next
End With
End Sub

Gruß
Nepumuk
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 21:33:08
Daniel
Hallo Sarah
mit VBA auf relativ einfachem Weg so:
Sub umformen()
Sheets("Tabelle1").Cells(1, 1).CurrentRegion.Copy
With Sheets("Tabelle3")
.Cells(1, 1).PasteSpecial xlPasteAll
With .Cells(1, 1).CurrentRegion
.Sort Header:=xlYes, _
key1:=.Cells(1, 1), order1:=xlAscending, _
key2:=.Cells(1, 2), order2:=xlDescending
With .Columns(.Columns.Count + 1)
With .Offset(1, 0).Resize(.Rows.Count - 1)
.FormulaR1C1 = "=IF(RC1=R[1]C1,R[1]C,RC2)"
.Copy
.Offset(0, 2 - .Column).PasteSpecial xlPasteValues
.ClearContents
End With
End With
.RemoveDuplicates 1, xlYes
End With
End With
End Sub

wenns ohne Programmierung sein soll, seit Version 2016 enthält Excel ein Tool namens PowerQuery, mit welchem man solche Umwandlungen erstellen und wiederholt ausführen lassen kann. Hierbei muss man nicht programmieren, sondern kann die Schritte über ein Menüs-Auswahlsystem ähnlich Excel selbst zusammenstellen.
Ist wie gesagt, seit Excel 2016 standardmäßiger bestandteil von Excel, je nach Version unter anderem Namen, vielleicht ist das ja was für dich (leider kenne ich mich damit noch nicht gut genug, aus, um dir da weiterhelfen zu können).
Gruß Daniel
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 22:13:33
Yal
Hallo zusammen,
ganz schön viel Helfer hier.
Die Lösung von Nepumuk schien mir umständlich. Ich habe eine Version mit Objekt und Collection gebaut (Modul1 und clsInstall, ob's besser ist, ist Geschmacksache).
Dann hat Daniel eine schlanke Lösung mit Remove Duplicate und hat Power Query erwähnt.
Daher in der Datei:
_ die Makro-Lösung befüllt die "Tabelle2" (*)
_ die Power Query Lösung befüllt die "Tabelle3"
(*): da ich Tabelle1 erst für die PowerQuery Lösung in Datentabelle umgewandelt, benutze ich nicht den DataRange in der VBA-Lösung.
https://www.herber.de/bbs/user/145539.xlsm
Viel Erfolg damit
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
14.04.2021 23:03:11
Daniel
HI Yal
eine reine VBA-Lösung mit Dictionary würde bei mir so aussehen:
Sub umformen2()
Dim arrQuelle, arrErg
Dim dic
Dim arrDatensatz
Dim z As Long, sp As Long
Dim ID
Set dic = CreateObject("scripting.dictionary")
arrQuelle = Sheets("Tabelle1").Cells(1, 1).CurrentRegion
'--- Daten erstellen
For z = 2 To UBound(arrQuelle, 1)
ID = arrQuelle(z, 1)
If dic.exists(ID) Then
arrDatensatz = dic(ID)
If arrDatensatz(2) > arrQuelle(z, 2) Then arrDatensatz(2) = arrQuelle(z, 2)
If arrDatensatz(5) 

etwas einfacher als bei Nepumuk und auch ohne Klassengedöns wie bei dir.
ist zwar noch fix auf die vier Spalten ausgelegt, aber das ließe sich anpassen.
meine erste Lösung mit dem Kopieren der ganzen Daten hat den Vorteil, dass Formatierungen wie Zahlenformate der Spalten usw automatisch mit übernommen werden, diese gehen bei reinen VBA-Lösungen verloren und müssten nachträglich erzeugt werden.
Gruß Daniel
Anzeige
AW: VBA - Vereinfachung Doppelter Werte
19.04.2021 12:10:43
Sarah

Vielen Dank für die tollen Lösungen! Ihr habt mir echt weitergeholfen!


Ich habe mich für die zweite Lösung von Daniel entschieden. Funktioniert perfekt.


Grüße
Sarah

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige