Top-Themen

Aktuelle Themen (A bis Z)

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
GELÖST

Quelltexterklärung?

Frage Microsoft Microsoft Office

Mitglied: Kleina

Kleina (Level 1) - Jetzt verbinden

04.02.2011, aktualisiert 12:15 Uhr, 2647 Aufrufe, 2 Kommentare

Hallo zusammen.

Habe einen Quellcode bekommen. Dieser ist ein Makro, um doppelte Datensätze einer Tabelle zu entfernen.
Das es funktioniert habe ich schon getestet.

Nur bin ich in VB nicht grad ein talent.

könnte mir jemand dieses Quellcode erklären??

Danke schonmal im Voraus !!!

01.
Sub DoppelteEintraegeLoeschen() 
02.
   
03.
  Dim colUnique As New Collection 
04.
  Dim lngAbZeile As Long 
05.
  Dim lngArr As Long 
06.
  Dim lngC As Long 
07.
  Dim lngCalc As Long 
08.
  Dim lngDup As Long 
09.
  Dim lngMaxArrays As Long 
10.
  Dim lngZ As Long 
11.
  Dim lngZeile As Long 
12.
  Dim lngZeilenArray As Long 
13.
  Dim lngZeilenBereich As Long 
14.
  Dim rngArea As Range 
15.
  Dim rngAuswahl As Range 
16.
  Dim rngC As Range 
17.
  Dim rngDel() As Range 
18.
  Dim rngSel As Range 
19.
  Dim strSuchbereich As String 
20.
  Dim strZeile As String 
21.
  Dim varAuswahl() As Variant 
22.
  Dim varC As Variant 
23.
  Set rngSel = Selection.EntireColumn 
24.
  lngZeilenBereich = ActiveSheet.UsedRange.Rows.Count 
25.
On Error GoTo FehlerBehandlung 
26.
  lngCalc = Application.Calculation 
27.
  Set rngAuswahl = Application.Intersect(Selection.EntireColumn, ActiveSheet.UsedRange) 
28.
  strSuchbereich = rngAuswahl.Address(0, 0) 
29.
  lngAbZeile = Abs(CLng(Application.InputBox( _ 
30.
    vbLf & "Ab welcher Zeile soll geprüft werden?", "Prüfbereich festlegen", 2, , , , , 1))) 
31.
  If lngAbZeile > 0 And lngAbZeile <= lngZeilenBereich Then 
32.
    Set rngAuswahl = Application.Intersect(Rows(lngAbZeile & ":" & lngZeilenBereich), rngSel) 
33.
  Else 
34.
    MsgBox "Die Zeile " & lngAbZeile & " liegt außerhalb des Bereichs """ & strSuchbereich & """!" 
35.
    Exit Sub 
36.
  End If 
37.
  lngZeilenArray = lngZeilenBereich - lngAbZeile + 1 
38.
  rngAuswahl.Select 
39.
  lngArr = 1 
40.
  ReDim rngDel(lngArr) 
41.
  lngMaxArrays = lngZeilenBereich / 50 
42.
  strSuchbereich = rngAuswahl.Address(0, 0) 
43.
  Application.Calculation = xlCalculationManual 
44.
  Application.ScreenUpdating = False 
45.
  For Each rngArea In rngAuswahl.Areas 
46.
    For Each rngC In rngArea.Columns 
47.
      lngC = lngC + 1 
48.
      ReDim Preserve varAuswahl(1 To lngC) 
49.
      varAuswahl(lngC) = rngC.Value 
50.
    Next rngC 
51.
  Next rngArea 
52.
  colUnique.Add 0, "" 'wenn 1. Leerzeile auch berücksichtigt werden soll 
53.
  For lngZeile = 1 To lngZeilenArray 
54.
    strZeile = "" 
55.
    For lngZ = 1 To lngC 
56.
      strZeile = strZeile & CStr(varAuswahl(lngZ)(lngZeile, 1)) 
57.
    Next lngZ 
58.
    colUnique.Add lngZeile, strZeile 
59.
  Next lngZeile 
60.
  Set rngDel(0) = rngDel(1) 
61.
  lngArr = lngArr + (rngDel(lngArr) Is Nothing) 
62.
  If lngArr > 1 Then 
63.
    For lngZ = 2 To lngArr 
64.
      Set rngDel(0) = Application.Union(rngDel(0), rngDel(lngZ)) 
65.
    Next lngZ 
66.
  End If 
67.
  lngDup = rngDel(0).Cells.Count / 256 
68.
  Application.Intersect(rngSel, rngDel(0)).Select 
69.
  Application.ScreenUpdating = True 
70.
  If MsgBox("Es wurden " & lngDup & " Duplikate im Bereich" & vbLf & _ 
71.
            strSuchbereich & vbLf & _ 
72.
            "gefunden." & vbLf & vbLf & "Sollen sie jetzt gelöscht werden?", _ 
73.
            vbQuestion Or vbYesNo Or vbDefaultButton2) = vbYes Then 
74.
    Application.ScreenUpdating = False 
75.
    For lngZ = lngArr To 1 Step -1 
76.
        rngDel(lngZ).Delete 
77.
    Next lngZ 
78.
    rngSel.Select 
79.
    Application.ScreenUpdating = True 
80.
  End If 
81.
FehlerBehandlung: 
82.
  Select Case Err.Number 
83.
    Case 457 
84.
      If rngDel(lngArr) Is Nothing Then 
85.
        Set rngDel(lngArr) = Rows(lngZeile + lngAbZeile - 1) 
86.
      Else 
87.
        Set rngDel(lngArr) = Application.Union(rngDel(lngArr), Rows(lngZeile + lngAbZeile - 1)) 
88.
      End If 
89.
      If rngDel(lngArr).Areas.Count = lngMaxArrays Then 
90.
        lngArr = lngArr + 1 
91.
        ReDim Preserve rngDel(lngArr) 
92.
      End If 
93.
      Resume Next 
94.
    Case 13, 91 
95.
        MsgBox "Im Bereich" & vbLf & vbLf & """" & strSuchbereich & """" & vbLf & vbLf & "gibt es keine Duplikate." 
96.
    Case Is > 0 
97.
      MsgBox "Fehlernummer: " & Err.Number & vbLf & vbLf & _ 
98.
            "Felerbeschreibung: " & Err.Description 
99.
      'für Entwicklung zum Testen 
100.
'      Application.Calculation = lngCalc 
101.
'      On Error GoTo 0 
102.
'      Resume 
103.
  End Select 
104.
  Application.Calculation = lngCalc 
105.
End Sub
Mitglied: Skyemugen
04.02.2011 um 12:11 Uhr
Aloha,

im Groben und Ganzen oder Zeile für Zeile? wobei man sich hier sogar vieles ergoogeln kann ... und mit 'nem Bisschen Englisch-Kenntnis auch verstehen

greetz André
Bitte warten ..
Mitglied: Kleina
04.02.2011 um 12:21 Uhr
im Groben würde reichen..es gibt ja nur manche Sachen die ich dabei nicht verstehe.
Die deklaration der variabeln ist ja klar.
Die Msgbox versteht sich auch von selbst.

nur bei der Abfrage habe ich meine Probleme
Bitte warten ..
Neue Wissensbeiträge
Perl

Perl hat heute Geburtstag: 30 Jahre Perl: Lange Gesichter zum Geburtstag

Information von Penny.Cilin vor 5 StundenPerl2 Kommentare

Hallo, auch wenn es wenige wissen und noch weniger Leute es nutzen. Perl hat heute Geburtstag. 30 Jahre Perl ...

Sicherheit

Blackberry stirbt - Keine Updates für Priv mehr

Tipp von certifiedit.net vor 5 StundenSicherheit

Blackberry wird zu einer 08/15 Firma und geht wohl mehr und mehr den Weg, den HTC schon ging. Von ...

Windows 10

Autsch: Microsoft bündelt Windows 10 mit unsicherer Passwort-Manager-App

Tipp von kgborn vor 2 TagenWindows 1010 Kommentare

Unter Microsofts Windows 10 haben Endbenutzer keine Kontrolle mehr, was Microsoft an Apps auf dem Betriebssystem installiert (die Windows ...

Sicherheits-Tools

Achtung: Sicherheitslücke im FortiClient VPN-Client

Tipp von kgborn vor 2 TagenSicherheits-Tools

Ich weiß nicht, wie häufig die NextGeneration Endpoint Protection-Lösung von Fortinet in deutschen Unternehmen eingesetzt wird. An dieser Stelle ...

Heiß diskutierte Inhalte
Batch & Shell
Kann man mit einer .txt Datei eine .bat Datei öffnen?
gelöst Frage von HelloWorldBatch & Shell22 Kommentare

Wie schon im Titel beschrieben würde ich gerne durch einfaches klicken auf eine Text oder Word Datei eine Batch ...

Netzwerkgrundlagen
Belibiges Teilnetz einer Subnetzmaske rausfinden?
gelöst Frage von CenuzeNetzwerkgrundlagen17 Kommentare

Wundervollen Gutentag, mittlerweile kann ich Subnetting so einigermaßen, aber ein Problem habe ich noch. Netzwerkadresse und Boradcast errechnen ist ...

LAN, WAN, Wireless
WLAN Reichweite erhöhen mit neuer Antenne
gelöst Frage von gdconsultLAN, WAN, Wireless12 Kommentare

Hallo, ich besitze einen TL-WN722N USB-WLAN Dongle mit einer richtigen Antenne. Ich frage mich jetzt ob man die Reichweite ...

Windows Server
Logging von "gesendeten Nachrichten" auf Terminalservern
gelöst Frage von Z3R0C0MM4N0THiN6Windows Server10 Kommentare

Hallo zusammen, kann mir jemand auf kurzem Wege sagen ob 1) die per Task-Manager (oder damals tsadmin) an Benutzer ...