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, 5339 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
VB for Applications
gelöst VBA Textbox fokussieren und Daten über Button eintragen (1)

Frage von Aximand zum Thema VB for Applications ...

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

Frage von Semmy1 zum Thema VB for Applications ...

Microsoft Office
gelöst VBA: Dateiinhalte in Abhängigkeit des Dateinamens importieren (4)

Frage von Booster07 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel VBA - Inhalte und Dateiname von txt-Dateien automatisch in Excel importieren (2)

Frage von Booster07 zum Thema Microsoft Office ...

Neue Wissensbeiträge
Rechtliche Fragen

Heiseshow, live ab 12 Uhr: Steht die Vorratsdatenspeicherung vor dem Aus?

Tipp von sabines zum Thema Rechtliche Fragen ...

Outlook & Mail

Outlook Probleme nach Juni Updates - KB3203467 ist Schuld

(1)

Information von Deepsys zum Thema Outlook & Mail ...

Microsoft Office

Windows 7, Office 2016 RTM und Updates ohne WSUS

Tipp von chgorges zum Thema Microsoft Office ...

E-Mail

Thunderbird 52 hat Druckprobleme

(3)

Tipp von magicteddy zum Thema E-Mail ...

Heiß diskutierte Inhalte
Server-Hardware
Einem Stromausfall entgegen wirken (22)

Frage von OIOOIOOIOIIOOOIIOIIOIOOO zum Thema Server-Hardware ...

Festplatten, SSD, Raid
PC stellt nach dem Bios ab (20)

Frage von uridium69 zum Thema Festplatten, SSD, Raid ...

Windows 7
Freeware MSI Tool (13)

Frage von uridium69 zum Thema Windows 7 ...