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 VBA - Makro zur Erstellung eines alphabetisierten Stichwortverzeichnisses in Excel

Mitglied: Rom682013

Rom682013 (Level 1) - Jetzt verbinden

08.03.2013, aktualisiert 13.03.2013, 1822 Aufrufe, 3 Kommentare

Liebe Profis,

wer kann mir von Euch helfen. Ich habe folgendes Problem:

In einer Excel-Arbeitsmappe habe ich unter anderem drei Arbeitsblätter: System, Schlagwörter und Stichwortverzeichnis. Nun soll im Arbeitsblatt „System“ in der Spalte A nach Schlagwörtern, die in Arbeitsblatt „Schlagwörter“ Spalte A ab Zelle 3 enthalten sind, gesucht werden. Wenn wahr, dann soll die ganze Zeile, da auch Einträge in Spalten B bis D vorhanden sind, kopiert und in Arbeitsblatt „Stichwortverzeichnis“ (bislang leer) eingefügt werden. Zudem soll variabel gesucht werden, d. h. Schlagwort „Verzeichnis“ Ausgabe „Verzeichnis“ und/oder „Verzeichnisses“ und/oder „Verzeichnisse“ bzw. Schlagwort „Auf- und Abbauten“ Ausgabe „ Auf- und Abbauten“ und/oder „auf- und abbau“. Das Arbeitsblatt „Stichwortverzeichnis“ soll wie folgt aufgebaut werden:

A
Such-Schlagwort
Ausgabe aus „System“
Ausgabe aus „System“
Ausgabe aus „System“
Such-Schlagwort
Ausgabe aus „System“
usw.

B
Such-Schlagwort
Ausgabe aus „System“
Such-Schlagwort
Ausgabe aus „System“
Ausgabe aus „System“
Such-Schlagwort
Ausgabe aus „System“
usw.

C
Such-Schlagwort
Ausgabe aus „System“
usw.

bis Z


Ich scheitere bereits beim Kopieren in das Arbeitsblatt „Stichwortverzeichnis“. Derzeit wird alles eingefügt, nur nicht das wonach ich suche.

Mein derzeitiges Makro lautet:

Sheets("SysKopie").Activate
Dim A, B, C, D, E, F
Dim Suchbegriff As String
Sheets("SysKopie").Select

A = Range(Sheets("Schlagwörter").Cells(1, 1), Sheets("Schlagwörter").Cells(1, 1).End(xlDown)).Rows.Count

B = Range(Sheets("SysKopie").Cells(1, 1), Sheets("SysKopie").Cells(1, 1).End(xlDown)).Rows.Count

For C = 2 To B
Suchbegriff = Sheets("Schlagwörter").Cells(C, 1).Value
For D = 2 To A
Cells(D, 1).Select 'kann man weglassen, man sieht aber wo man ist
E = Cells(D, 1).Value
F = InStr(1, E, Suchbegriff, vbTextCompare)
If F > 0 Then
ActiveCell.EntireRow.Copy
Sheets("Stichwortverzeichnis").Range("A" & zelle.Row) = zelle.Offset(0, 1)
End If
F = 0
Next D
Next C
Sheets("Stichwortverzeichnis").Activate
Cells(3, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, _
8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21), Header:=xlNo

Und bleibt im Testlauf bei der Zeile
Sheets("Stichwortverzeichnis").Range("A" & zelle.Row) = zelle.Offset(0, 1)
stehen.

Wer kann mir da helfen. Im Voraus besten Dank!

Viele Grüße
Rom682013
Mitglied: colinardo
08.03.2013 um 12:28 Uhr
Hi Rom682013,
hier solltest du Antworten auf deine Fragen finden: https://www.administrator.de/contentid/202195
Grüße Uwe
Bitte warten ..
Mitglied: bastla
15.03.2013, aktualisiert um 17:14 Uhr
Hallo Rom!

Auf Basis der per Mail erhaltenen Beispieldatei könnte das schematisch etwa so gehen:
01.
Sub Stichwortverzeichnis_erstellen() 
02.
 
03.
SchlagTabelle = "Schlagwörter" 
04.
QuellTabelle = "SysKopie" 
05.
ZielTabelle = "Stichwortverzeichnis" 
06.
 
07.
SchlagAb = "A3" 'Zelle mit erstem Schlagwort 
08.
QuellSpalte = "A" 'erste Datenspalte der Quelldatei - hier wird gesucht 
09.
QuellSpaltenAnzahl = 3 'Anzahl zu kopierender Spalten 
10.
 
11.
ZielAb = "A3" 'erste Zelle der Zieldatei 
12.
 
13.
Set STab = Worksheets(SchlagTabelle) 
14.
Set QTab = Worksheets(QuellTabelle) 
15.
Set ZTab = Worksheets(ZielTabelle) 
16.
 
17.
SZeile = STab.Range(SchlagAb).Row 
18.
SSpalte = STab.Range(SchlagAb).Column 
19.
 
20.
ZZeile = ZTab.Range(ZielAb).Row 
21.
ZSpalte = ZTab.Range(ZielAb).Column 
22.
 
23.
Application.StatusBar = True 'Anzeige in Statusleiste aktivieren 
24.
Schlagwort = STab.Cells(SZeile, SSpalte).Value 'erstes Schlagwort auslesen 
25.
Do While Schlagwort <> "" 'wiederholen. solange noch Schlagwörter gefunden werden 
26.
    Buchstabe = UCase(Left(Schlagwort, 1)) 'Anfangsbuchstabe 
27.
    If Buchstabe <> BuchstabeZuletzt Then 'neuer Buchstabe? 
28.
        ZTab.Cells(ZZeile, ZSpalte).Value = Buchstabe 'Buchstaben eintragen ... 
29.
        ZTab.Cells(ZZeile, ZSpalte).Font.Bold = True '... fett formatieren ... 
30.
        BuchstabeZuletzt = Buchstabe '... und merken 
31.
        ZZeile = ZZeile + 1 'nächste Zeile in Zieldatei 
32.
        Application.StatusBar = "Bearbeite Buchstabe:  " & Buchstabe 'Aktuell bearbeiteten Buchstaben in der Stautsleiste anzeigen 
33.
    End If 
34.
    Set c = QTab.Columns(QuellSpalte).Find(Schlagwort, LookIn:=xlValues) 'gesamte Spalte durchsuchen 
35.
    If Not c Is Nothing Then 'gefunden? 
36.
        ZTab.Cells(ZZeile, ZSpalte).Value = Schlagwort 'Schlagwort eintragen ... 
37.
        ZTab.Cells(ZZeile, ZSpalte).Font.Bold = True '... und fett formatieren 
38.
        STab.Cells(SZeile, SSpalte).Offset(0, 1).Value = "vorhanden" 
39.
        ZZeile = ZZeile + 1 'nächste Zeile der Zieltabelle 
40.
        Zuerst = c.Address 'erste Fundstelle merken 
41.
        Do 
42.
            c.Resize(1, QuellSpaltenAnzahl).Copy ZTab.Cells(ZZeile, ZSpalte) 
43.
            ZZeile = ZZeile + 1 'nächste Zeile in Zieldatei 
44.
            Set c = QTab.Columns(QuellSpalte).FindNext(c) 'weitersuchen 
45.
        Loop While Not c Is Nothing And c.Address <> Zuerst 'bis nix oder erster Fund gefunden wird 
46.
        ZZeile = ZZeile + 1 'für Leerzeile in Zieldatei 
47.
    Else 'Schlagwort nicht gefunden 
48.
        STab.Cells(SZeile, SSpalte).Offset(0, 1).Value = "nicht vorhanden" 
49.
    End If 
50.
    SZeile = SZeile + 1 'nächste Zeile in Schlagworttabelle 
51.
    Schlagwort = STab.Cells(SZeile, SSpalte).Value 'nächstes Schlagwort auslesen 
52.
Loop 
53.
Application.StatusBar = False 'Statusleistenanzeige abschalten 
54.
MsgBox "Fertig." 
55.
End Sub
Zusätzliche Formatierungen, andere Suchparameter (Zeile 34), etc bekommst Du ja bei Bedarf vielleicht auch selbst hin ...

Grüße
bastla

[Edit] Statusleistenanzeige hinzugefügt [/Edit]
Bitte warten ..
Mitglied: Rom682013
17.03.2013 um 22:27 Uhr
Hallo bastla,

vielen, vielen lieben Dank! Das Makro funktioniert bestens. Ich hätte das auf die Schnelle nie so hinbekommen. Danke auch für die Kommentierungen. Den „Rest“ bekomme ich selber hin.
Ich sag nur: „You’re the best champion of the year“.

Viele Grüße
Rom
Bitte warten ..
Ähnliche Inhalte
Microsoft Office

Excel Makro VBA Sortierung nach Spaltennamen

gelöst Frage von easy4breezyMicrosoft Office3 Kommentare

Hi Leute, ich habe mich hier schon eingelesen und auch im Internet, aber irgendwie komme ich zu keiner Lösung ...

Microsoft Office

VBA Makro Mails aus Excel versenden

gelöst Frage von ExxiStMicrosoft Office7 Kommentare

Guten Tag zusammen, folgendes Problem treibt mich schon seit Tagen zur Verzweiflung: Aus einer Excel Datei werden durch folgendes ...

Microsoft Office

Dublikate Entfernen per Excel Makro VBA

gelöst Frage von novregenMicrosoft Office3 Kommentare

Hallo, ich habe eine Excel Liste mit variabler Zeilenanzahl und 33 Spalten. Diese Liste bekomme ich monatlich. Leider gibt ...

VB for Applications

Fusszeile mit PageSetup mit VBA in Excel Makro funktioniert nicht?

Frage von HerrHartVB for Applications5 Kommentare

Ich habe eine Fusszeile mit dem Macro Recorder unter Excel 2013 aufgenommen: With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = ...

Neue Wissensbeiträge
Server-Hardware
HP iLO ist gefährdet (iLO 4))
Tipp von AlFalcone vor 2 StundenServer-Hardware

Gemäss Twitter und Heise gibt es eine Angriffsmöglichkeit auf iLO iLO ist gefährdet Copyright © und alle Rechte liegen ...

CMS
Erneut kritische Zero-Day-Lücke in Drupal
Tipp von Reini82 vor 11 StundenCMS

Laut einem Bericht auf t3n gibt es eine Schwere Sicherheitslücke in Drupal die auch schon ausgenutzt wird. Betroffen sind ...

Sicherheit

MikroTik-Router patchen, Schwachstelle wird ausgenutzt

Information von kgborn vor 1 TagSicherheit

Am 23. April 2018 wurde von Mikrotik ein Security Advisory herausgegeben, welches auf eine Schwachstelle im RouterOS hinwies. Mikrotik ...

Windows 10

Microcode-Updates KB4090007, KB4091663, KB4091664, KB4091666 für Windows 10

Information von kgborn vor 1 TagWindows 101 Kommentar

Kurze Information für Administratoren von Windows 10-Systemen, die mit neueren Intel CPUs laufen. Microsoft hat zum 23. April 2018 ...

Heiß diskutierte Inhalte
Windows Server
Alten DC entfernen
gelöst Frage von smartinoWindows Server27 Kommentare

Hallo zusammen, ich habe hier eine Umgebung übernommen und erstmal einen DCDIAG gemacht. Dabei fällt auf, daß eine ganze ...

Ausbildung
Wie gelingt ein guter Einstieg in die FiSi-Ausbildung? (Umschulung)
Frage von SiAnKoAusbildung27 Kommentare

Schönen guten Tag, ich bin SiAnKo und habe seit dem 1.04.2018 eine Umschulung als FiSi angefangen. Ich möchte natürlich ...

Batch & Shell
Mit Powershell den Inhalt einer Excel mit einer Text Datei abgleichen
gelöst Frage von Bommi1961Batch & Shell21 Kommentare

Hallo zusammen, ich muss den Inhalt einer Excel Datei (Mappe1) mit dem Daten einer Text Datei abgleichen. Die Daten ...

Router & Routing
Subnetzmaske vergrößern
gelöst Frage von groovesurferRouter & Routing18 Kommentare

Hallo, hat jemand schonmal getestet was passiert, wenn man die Subnetzmaske bei laufendem Betrieb (wenn user im Netzwerk verbunden ...