Thema Datum  Von Nutzer Rating
Antwort
05.05.2018 09:17:37 Anja
NotSolved
Blau Excel Makro
05.05.2018 10:10:52 u
NotSolved
08.05.2018 09:45:10 Anja
NotSolved
08.05.2018 11:17:43 Gast38101
NotSolved
05.05.2018 20:34:48 Mackie
NotSolved
08.05.2018 19:22:57 Gast67515
NotSolved

Ansicht des Beitrags:
Von:
u		 Datum:
05.05.2018 10:10:52		 Views:
668		 Rating:
     
Antwort:
  Ja
Thema:
Excel Makro

Hi,

mal 1 zu 1 übersetzt:

Sub AnjasHausaufgabe()
Dim wbQuelle As Workbook
Dim sFilename As String
Dim lFile As Long
Dim sSuchbegriff As Variant
Dim rSuchrange As Range
Dim rFund As Range
Dim wsZiel As Worksheet
Dim lZielZeile As Long

Set wsZiel = Workbooks.Add().Worksheets(1)                      'Neue Datei anlegen und auf 1. Tabellenblatt verweisen
lZielZeile = 1

'Schleife über alle Dateineman
For lFile = 1 To 6
    sFilename = "c:\anja\" & lFile & ".xlsx"                    'Dateiname generieren     <<== anpassen!
    Set wbQuelle = Workbooks.Open(sFilename, ReadOnly:=True)    'Datei öffnen
    Set rSuchrange = wbQuelle.Worksheets(1).Range("A1:C12")     'Suchrange definieren
    
    'Schleife über alle Suchbegriffe
    For Each sSuchbegriff In Array("Äpfel", "Bananen", "Mandarinen", "Apfelsinen")
        Set rFund = rSuchrange.Cells.Find(sSuchbegriff, , xlValues, xlWhole)    'Nach Obst suchen
        If Not rFund Is Nothing Then                                            'Wenn was gefunden wurde
            wsZiel.Cells(lZielZeile, 1).Value = rFund.Offset(0, 1).Value        'Wert übernehmen
            lZielZeile = lZielZeile + 1                                         'neue Zeilennummer
        End If
        Set rFund = Nothing
    Next sSuchbegriff
    
    wbQuelle.Close                                              'Datei schlieüen
    
Next lFile

wsZiel.Parent.SaveAs "c:\anja\Test2", FileFormat:=51            'neu erstellte Datei speichern  <<== anpassen!
    
End Sub

Schönes Wochenende

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.05.2018 09:17:37 Anja
NotSolved
Blau Excel Makro
05.05.2018 10:10:52 u
NotSolved
08.05.2018 09:45:10 Anja
NotSolved
08.05.2018 11:17:43 Gast38101
NotSolved
05.05.2018 20:34:48 Mackie
NotSolved
08.05.2018 19:22:57 Gast67515
NotSolved