Autor
|
Thema: Dubletten suchen & löschen mit ext. Tabelle (1466 mal gelesen)
|
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 23. Mrz. 2012 18:06 <-- editieren / zitieren --> Unities abgeben:
Hallo! Ich habe einen netten VBA Code, der mir in meiner Tabelle alle Dubletten sucht und löscht. Was muß Ich an diesem Code genau umschreiben, damit er aus Tabelle1 alle Werte löscht, die auch in Tabelle2 vorkommen. ------------------ Mit freundlichen Grüßen
CADdoctor [Diese Nachricht wurde von CADdoctor am 23. Mrz. 2012 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 26. Mrz. 2012 08:49 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hi, ohne in den Anhang zu gucken: Woher hast Du den Code? Klingt ja nicht gerade nach selbst geschrieben... Prinzipielle Vorgehensweise: Tab2 durchsuchen, alle Einträge in eine Liste (array) schreiben; gleiches für Tab1. In einem dritten Lauf die beiden arrays abgleichen, Treffer in ein drittes Array schreiben. Dieses in Tab1 löschen. Du willst nur die Werte löschen, nicht ganze Zeilen oder so? ------------------ DIN1055.de | Lastannahmen für Anwender Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 01. Apr. 2012 04:42 <-- editieren / zitieren --> Unities abgeben:
|
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 02. Apr. 2012 09:25 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Tach, Zitat: Bei diesem Code wid die ganze Zeile gelöscht!
Daraus schließe ich, dass Du nicht die ganze Zeile löschen willst, sondern einzelne Werte? Leicht machst Du es einem ja nicht gerade - bestätigst Du diese Vermutung? Zumindest hast Du Dir beim Copy+Paste in "Deine" Mappe die Mühe gemacht, den Namen des Autors zu entfernen - schade, SCNR . Ich vermute, der Schlüssel liegt hier im Code: For lngZ = lngArr To 1 Step -1 rngDel(lngZ).Delete Next lngZ
Hier wird wohl ein Range (=Bereich) "Zeile" gelöscht (ins Blaue hinein); damit bin ich vorerst 'raus aus dem Thema.------------------ DIN1055.de | Lastannahmen für Anwender Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Thomas Harmening Moderator Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 Das Innerste geäussert und aufs Äusserste verinnerlicht
|
erstellt am: 02. Apr. 2012 23:26 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Zitat: Original erstellt von CADdoctor: ...damit er aus Tabelle1 alle Werte löscht, die auch in Tabelle2 vorkommen.
hmmm, wenn t1.zelle(n) = t2.zelle.(n) = WAHR oder wenn t1.zelle(n) = t2.beliebige.zelle.(n) = WAHR für erstere - ich habe mal einen kürzeren Schnippsel aus dem Netz geholt
Code: Sub del_doppelt() 'abgeaendert aus aus http://www.office-loesung.de/ftopic168093_0_0_asc.php Dim EinmaligInQuelle2 As Object Dim Quelle1 As Range, Quelle2 As Range, Zelle As RangeWith Worksheets("Tabelle1") Set Quelle1 = .Range("A1:C" & Range("A65536").End(xlUp).Row) End With With Worksheets("Tabelle2") Set Quelle2 = .Range("A1:C" & Range("A65536").End(xlUp).Row) End With Set EinmaligInQuelle2 = CreateObject("scripting.dictionary") For Each Zelle In Quelle2 If EinmaligInQuelle2.Exists(Zelle.Text) = False Then EinmaligInQuelle2.Add Zelle.Text, Zelle.Text End If Next Zelle Application.ScreenUpdating = False For I = Quelle1.Cells.Count To 1 Step -1 If EinmaligInQuelle2.Exists(Quelle1.Cells(I).Text) = True Then Quelle1.Cells(I) = "weg" '"" alternativ End If Next I Application.ScreenUpdating = True End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |