Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Mit VBA Daten aus externen Quellen importieren und verarbeiten

Frage Entwicklung VB for Applications

Mitglied: VBANeuling85

VBANeuling85 (Level 1) - Jetzt verbinden

23.03.2014 um 12:27 Uhr, 5461 Aufrufe

Hallo zusammen,

ich möchte eine neue Liste erstellen mit Kontakten, die noch nicht im Bestand auftauchen.

Als ersten Schritt lade ich den Inhalt aus den beiden externen Quellen (Excel) in mein Datenblatt.

1. Datei = BESTANDSKUNDEN.xls
2. Datei = NEUEADRESSEN.xls

Beide Tabellen haben den Aufbau Name, Vorname, Straße, PLZ, Ort, Telefon

Code:

Option Explicit

Const HomeDatei = "Telefonliste.xlsm" 'Name Arbeitsmappe Makro-Excel-Datei
Const HomeDaten = "Daten-Import" 'Name Tabellenblatt Daten-Import
Const HomeListe = "Datei-Liste" 'Name Tabellenblatt Datei-Liste
Const HomeZeile = 3 'Erste Zeile Einfügen
Const CopyZeile = 3 'Erste Zeile Kopieren
Const ListDatei = "A1" 'Zelle erster Dateiname
Const ErrMsg = "Abbruch! Datei existiert nicht: "

Sub SheetsImport()

Dim WksHome As Worksheet, WksList As Worksheet, EndLine As Integer, NextLine As Integer

Dim WkbCopy As Workbook, WksCopy As Worksheet, Fso As Object, File As Object

Set Fso = CreateObject("Scripting.FileSystemObject")

Set WksHome = Workbooks(HomeDatei).Sheets(HomeDaten)

Set WksList = Workbooks(HomeDatei).Sheets(HomeListe)

EndLine = GetEndLine(WksHome): NextLine = HomeZeile

If EndLine >= HomeZeile Then WksHome.Rows("3:" & EndLine).Cells.Clear

Application.ScreenUpdating = False

For Each File In WksList.Range(ListDatei).CurrentRegion

If Fso.FileExists(File) = False Then

Application.ScreenUpdating = True

MsgBox ErrMsg & File, vbExclamation, "Fehler": Exit Sub

End If

Set WkbCopy = Workbooks.Open(File): Set WksCopy = WkbCopy.Sheets(1)

EndLine = GetEndLine(WksCopy)

If EndLine >= CopyZeile Then

WksCopy.Rows("3:" & EndLine).Copy

WksHome.Rows(NextLine).Insert Shift:=xlDown

Application.CutCopyMode = False

WkbCopy.Saved = True: WkbCopy.Close

NextLine = GetEndLine(WksHome) + 1

End If

Next

Application.ScreenUpdating = True

End Sub


Im zweiten Schritt lösche ich zunächst Dubletten (doppelte Datensätze), die drei von vier Kriterien erfüllen. Nämlich wenn drei von vier Spalteninhalten Name, Vorname, PLZ oder Telefon identisch sind.

Bis hier funktioniert alles wunderbar.

Code:

Sub Dublettenbereinigung()
Dim Spalten(1 To 4) As Long
Dim sp As Long
Dim i As Long
Dim Fo As String

'--- Hier Zeilen- und Spaltennummern eintragen

Const ErsteDatenZeile As Long = 3
Spalten(1) = 1 ' Spaltennummer Name
Spalten(2) = 2 ' Spaltennummer Vorname
Spalten(3) = 5 ' Spaltennummer PLZ
Spalten(4) = 7 ' Spaltennummer Telefon


'--- Prüfformel für Duplikate erstellen
Fo = "=If(or(((RCw=R[-1]Cw)+(RCx=R[-1]Cx)+(RCy=R[-1]Cy)+(RCz=R[-1]Cz))>=3,((RCw=R[1]Cw)+(RCx=R[1]Cx)+(RCy=R[1]Cy)+(RCz=R[1]Cz))>=3),1,"""")"

For i = 1 To 4
Fo = Replace(Fo, Chr(Asc("v") + i), Spalten(i))
Next



With Range(Cells(ErsteDatenZeile, 1), Cells.SpecialCells(xlCellTypeLastCell))
For i = 1 To 4
'--- Sortieren, so das Duplikate untereinander stehen
For sp = 1 To 4
If sp <> i Then .Sort Key1:=.Cells(1, Spalten(sp)), order1:=xlAscending, Header:=xlNo
Next
'--- per Formel auf Dupliakte prüfen und Zeilen löschen
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = Fo
.Formula = .Value
If WorksheetFunction.Sum(.Cells) > 0 Then
.EntireRow.Sort Key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
End If
.ClearContents
End With
Next

'--- Sortieren nach Namen
.Sort Key1:=.Cells(1, Spalten(1)), order1:=xlAscending, key2:=.Cells(1, Spalten(2)), order2:=xlAscending, Header:=xlNo

End With

End Sub


Nun möchte ich aber in einem dritten Schritt alle Datensätze aus meiner importierten Liste löschen, die in der Datei BESTANDSDATEN.xls vorhanden sind.

So soll dann am Ende folgende Liste angezeigt werden.

=NEUE ADRESSEN+BESTANDSKUNDEN-DOPPELTE EINTRÄGE-BESTANDSKUNDEN

Hierfür fehlt mir das Verständnis. Können Sie mir da weiterhelfen?

Einen schönen Sonntag.
Ähnliche Inhalte
Microsoft Office
gelöst VBA: Dateiinhalte in Abhängigkeit des Dateinamens importieren (4)

Frage von Booster07 zum Thema Microsoft Office ...

VB for Applications
gelöst Zuordnen von Daten per VBA aus zweitem anderen Tabellenblättern (4)

Frage von Semmy1 zum Thema VB for Applications ...

VB for Applications
Excel VBA Sortierung von Daten (5)

Frage von easy4breezy zum Thema VB for Applications ...

Neue Wissensbeiträge
Windows Update

Microsoft Update KB4034664 verursacht Probleme mit Multimonitor-Systemen

(2)

Tipp von beidermachtvongreyscull zum Thema Windows Update ...

Viren und Trojaner

CNC-Fräsen von MECANUMERIC werden (ggf.) mit Viren, Trojanern, Würmern ausgeliefert

(4)

Erfahrungsbericht von anteNope zum Thema Viren und Trojaner ...

Windows 10

Windows 10: Erste Anmeldung Animation deaktivieren

(3)

Anleitung von alemanne21 zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Netzwerkprotokolle
gelöst Leiten "dumme" Switches VLAN-Tags mit durch? (26)

Frage von coltseavers zum Thema Netzwerkprotokolle ...

Windows Server
gelöst Neues KB für W10 1607 und W2K16 wieder mal nicht im WSUS 3.0, hat das noch jemand? (16)

Frage von departure69 zum Thema Windows Server ...

Netzwerkgrundlagen
Kann auf Freigabe nicht Zugreifen (15)

Frage von leon123 zum Thema Netzwerkgrundlagen ...

Router & Routing
FTTH bzw FTTB Router (13)

Frage von ukulele-7 zum Thema Router & Routing ...