Office: (Office 2013) Makro ändern auf Excel4Macro

Helfe beim Thema Makro ändern auf Excel4Macro in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo Zusammen, vor einiger Zeit hat ein Kollege von mir das unten stehende Makro geschrieben. Hier werden Dateien geöffnet und Werte ausgelesen.... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von merkurmedium, 26. Mai 2021.

  1. Makro ändern auf Excel4Macro


    Hallo Zusammen,
    vor einiger Zeit hat ein Kollege von mir das unten stehende Makro geschrieben.
    Hier werden Dateien geöffnet und Werte ausgelesen.
    Leider werden die Dateien alle geöffnet und ausgelesen.

    Nun habe ich gelesen das man mit Excel4Macro auch die geschlossene Datei auslesen kann.

    Ist es möglich das man das Makro so umschreibt das die Dateien in geschlossenem Zustand ausgelesen werden ?


    Code:
    Option Explicit
    Sub Auswertung()
       'Alle Dateien des gewählten Ordners werden geöffnet.
       'Bestimmte Tageswerte werden gesammelt und ausgegeben.
       Dim oFSO          As Object         'FileSystemObject
       Dim oFolder       As Object         'Folder-Objekt
       Dim oFile         As Object         'File-Objekt
       Dim ws            As Worksheet
       Dim Quelle        As Object         'Dict für alle Dateien
       Dim colAuswertung As Collection     'Coll für alle Arrays einer Datei
       Dim Daten         As Variant        'Array
       Dim Ecke          As Range          'Basiszelle eines Bereichs
       Dim Bereich       As Range          'Bearbeitungsbereich
       Dim Zelle         As Range          'Bearbeitungszelle
       Dim Datum         As Date
       Dim iZeile        As Long           'laufende Zahl
       Dim iSchicht      As Long           'laufende Zahl
       Dim i_Teil        As Long           'laufende Zahl
       Dim p_Teil        As Long           'laufende Zahl
       Dim Summe         As Double         'Summe der Zeiten
       Dim IstWert       As Variant
      
       Application.ScreenUpdating = False
      
       Set Quelle = CreateObject("Scripting.Dictionary")      'Dict bekommt für jede Datei eine Coll
       Datum = Worksheets("T (Produktionsbericht)").Range("B1")
      
       Set oFSO = CreateObject("Scripting.FileSystemObject")
       If Worksheets("Input").Range("I2") = "" Then Call Ordnerauswahl(Worksheets("Input").Range("I2"))
       Set oFolder = oFSO.GetFolder(Worksheets("Input").Range("I2"))
    '   Debug.Print "Pfad:", oFolder.Path          'Ordnerpfad\Ordnername
    '   Debug.Print "Anzahl Dateien:", oFolder.Files.Count
      
       'Alle Dateien im Folder werden in durchlaufen
       For Each oFile In oFolder.Files
    '         Debug.Print "Datei:", oFile.Name    'Dateiname
            
          'Einzelne Datei wird geöffnet
          With Workbooks.Open(Filename:=oFile.Path, UpdateLinks:=0, ReadOnly:=True)
            
    '         Debug.Print .Name
             'Blattname "täglicheEingaben" suchen
             For Each ws In .Sheets
                 If ws.Name = "täglicheEingaben" Then Exit For
             Next ws
            
             If ws Is Nothing Then
            
                'Blattname "täglicheEingaben" existiert nicht
                MsgBox "Die Datei " & vbCr & vbCr & _
                      .Name & vbCr & vbCr & _
                      "wird nicht ausgewertet, weil das Blatt " & vbCr & vbCr & _
                      "täglicheEingaben" & vbCr & vbCr & _
                      "nicht vorhanden ist. "
             Else
    
    
                'Blattname "täglicheEingaben" existiert
                With ws
                  
                   'Datum wird gesucht
                   For iZeile = 5 To 1055 Step 35
                      If .Range("C" & iZeile) = Datum Then Exit For
                   Next iZeile
                  
                   If iZeile <= 1055 Then
    
                      'Auswertung der Teile
                      ReDim Daten(1 To 10, 1 To 4)
                      For iSchicht = 1 To 3
                         p_Teil = 0     'Einträge in p-Plan
                         For i_Teil = 1 To 5
                            IstWert = .Cells(iZeile + 2 + i_Teil * 3, 1 + 9 * iSchicht) 'Ist
                            If IstWert > 0 Then
                               p_Teil = p_Teil + 1
                               'Wenn IstWert existiert, für diesen Teil Teilenummer, Soll und Ist übertragen
                              
                               Daten(p_Teil + 0, iSchicht) = .Cells(iZeile + 1 + i_Teil * 3, 1)                 'Name
                               Daten(p_Teil + 3, iSchicht) = .Cells(iZeile + 1 + i_Teil * 3, 1 + 9 * iSchicht)  'Soll
                               Daten(p_Teil + 6, iSchicht) = IstWert                                            'Ist
                               If p_Teil = 3 Then Exit For      'maximal 3 Einträge in Daten möglich
                            End If
                         Next i_Teil
                         Daten(10, iSchicht) = .Cells(iZeile + 20, 1 + 9 * iSchicht) 'Anlagenauslastung
    
                      Next iSchicht
                      
                      'Nächster Tag, nur Frühschicht
                      p_Teil = 0     'Einträge in p-Plan
                      For i_Teil = 1 To 5
                         IstWert = .Cells(iZeile + 35 + 2 + i_Teil * 3, 3)  'Ist, Erste Stunde
                         If IstWert > 0 Then
                            p_Teil = p_Teil + 1
                            'Wenn IstWert existiert, für diesen Teil Teilenummer, Soll und Ist übertragen
                            
                            Daten(p_Teil + 0, 4) = .Cells(iZeile + 35 + 1 + i_Teil * 3, 1)                'Name
    '                        Daten(p_Teil + 3, 4) = .Cells(iZeile + 35 + 1 + i_Teil * 3, 10)               'Soll
    '                        Daten(p_Teil + 6, 4) = IstWert                                            'Ist
                            If p_Teil = 3 Then Exit For      'maximal 3 Einträge in Daten möglich
                         End If
                      Next i_Teil
                      Daten(10, 4) = .Cells(iZeile + 35 + 20, 10) 'Anlagenauslastung
    
                      Set colAuswertung = New Collection           'Sammlung der einzelnen Arrays aus der Quelle
                      colAuswertung.Add Daten, "Auslastung"        'Eintrag in Coll. colAuswertung
                      
                      'Auswertung der Stillstände
                      For iSchicht = 1 To 3
                         Daten = .Range(Cells(iZeile + 26, 9 * iSchicht - 6), Cells(iZeile + 33, 9 * iSchicht))
                         colAuswertung.Add Daten, "Schicht" & iSchicht     'Eintrag in Coll. colAuswertung
                      Next iSchicht
                      Quelle.Add .Range("I1").Text, colAuswertung
                      
                   End If
                End With
             End If
             .Close savechanges:=False  'Datei wird geschlossen
          End With
       Next oFile
       Application.ScreenUpdating = True
      
      
       'Eintragung in Blatt Produktionsbericht
       Set Ecke = Worksheets("T (Produktionsbericht)").Range("A2")
       Do While Ecke <> ""
    
    'Debug.Assert Ecke.Text <> "Chiron 12"
          ReDim Daten(1 To 10, 1 To 4)
          If Quelle.exists(Ecke.Text) Then Daten = Quelle(Ecke.Text)("Auslastung")
          Ecke.Offset(1, 1).Resize(UBound(Daten, 1), UBound(Daten, 2)) = Daten
          Set Ecke = Ecke.Offset(12)
       Loop
    
    
       'Eintragung in Blatt Input
       Set Ecke = Worksheets("Input").Range("A3")
       Do While Ecke <> ""
          
          'Durchlauf im Blatt Input, bis kein Eintrag mehr gefunden
          Set Bereich = Range(Ecke.Offset(1), Ecke.End(xlDown))
          If Quelle.exists(Ecke.Text) Then
             For iSchicht = 1 To 3
                
                'Für jede Schicht jeden gefragten Störgrund suchen
                Daten = Quelle(Ecke.Text)("Schicht" & iSchicht)
                For Each Zelle In Bereich.Offset(, 2 * iSchicht)
                  
                   Summe = 0
                   If Zelle <> "" Then     'Nur suchen, wenn Suchbegriff Zelle existiert
                      
                      'Alle Störungszeiten des Störgrund Zelle summieren
                      'Spalte 1 durchsuchen: Ergebnis aus Spalte 3
                      For iZeile = 1 To UBound(Daten, 1)
                         If Zelle = Daten(iZeile, 1) Then Summe = Summe + Daten(iZeile, 3)
                      Next iZeile
                      
                      'Spalte 4 durchsuchen: Ergebnis aus Spalte 7
                      For iZeile = 1 To UBound(Daten, 1)
                         If Zelle = Daten(iZeile, 4) Then Summe = Summe + Daten(iZeile, 7)
                      Next iZeile
                   End If
                   Zelle.Offset(, 1) = IIf(Summe > 0, Summe, "")
                Next Zelle
             Next iSchicht
          Else
          
             'Keine Maschinendatei vorhanden
             Bereich.Offset(, 3) = ""      'Schicht 1 löschen
             Bereich.Offset(, 5) = ""      'Schicht 2 löschen
             Bereich.Offset(, 7) = ""      'Schicht 3 löschen
          End If
        
          Set Ecke = Ecke.End(xlDown).Offset(2)
          
       Loop
       ThisWorkbook.Save
       Range("B2").Select
       MsgBox "Aktualisierung beendet"
    End Sub
     
    merkurmedium, 26. Mai 2021
    #1
  2. Beverly
    Beverly Erfahrener User
    Hi,

    das stimmt so nicht ganz - es ginge nur, per VBA Bezugs-Formeln zu den betreffenden Zellen zu erstellen und so die Daten in die Zielmappe zu holen - aber das ist sehr kompliziert, zumal du die Daten auch noch mit Bedingung übernehmen willst.

    Weshalb sollen die Dateien denn überhaupr geschlossen bleiben? Du kannst sie doch öffnen und musst sie nur nach dem Übertragen der Daten wieder schließen. Und wenn du an den Anfang deines Codes noch die Zeile Application.ScreenUpdating = False schreibst, wird die Bildschirmaktualisierung ausgeschaltet und niemand bemerkt, dass die Dateien geöffnet werden.
    Nicht vergessen, am Ende mittels Application.ScreenUpdating = True die Bildschirmaktualisierung wieder einzuschalten.


    Makro ändern auf Excel4Macro GrußformelMakro ändern auf Excel4Macro Beverly's Excel - Inn
     
    Beverly, 26. Mai 2021
    #2
    1 Person gefällt das.
  3. Hallo,
    mir kam in den Sinn das es durch das nicht öffnen etwas schneller gehen würde.
    Aber wenn es sehr umständlich ist dann lasse ich es so.
    Besten dank für Deinen Tipp.
     
    merkurmedium, 26. Mai 2021
    #3
  4. Exl121150 Erfahrener User

    Makro ändern auf Excel4Macro

    Hallo,

    auf die Arbeitsblattzelle einer "geschlossenen" Exceldatei kann man wie folgt (Musterbeispiel) zugreifen:
    ='C:\Office-Hilfe\[cdv_Kopieren.xlsm]kw4'!$A$2
    Dabei muss man die Syntax des Zellzugriffes genau einhalten, die Formel enthält folgende Bestandteile:
    C:\Office-Hilfe\ ist der Zugriffspfad
    [cdv_Kopieren.xlsm] ist der Excel-Dateiname, wobei die eckigen Klammern um den Dateinamen Pflicht sind
    kw4 ist der Arbeitsblattname
    $A$2 ist die Arbeitsblattzelle
    Ferner muss 'Pfad\[Dateiname]Arbeitsblatt' in Hochkommas gesetzt werden und natürlich das Ausrufezeichen zwischen Arbeitsblattname und Arbeitsblattzelle gesetzt werden (aber das müsste eh klar sein).

    Ich habe vorhin von einer "geschlossenen" Exceldatei gesprochen. Das ist aber nur eine schlichte Täuschung, denn auf geschlossene Dateien kann auch Microsoft nicht zugreifen. Natürlich wird bei Verwendung dieser Formel die enthaltene Datei im Dateisystem gesucht, geöffnet, der Zellinhalt abgeholt und die Datei hinterher wieder geschlossen. Das erfolgt im Hintergrund und benötigt natürlich genauso Rechenzeit.
     
    Exl121150, 29. Mai 2021
    #4
    1 Person gefällt das.
  5. Hallo Anton,

    danke für Deine Informationen.
     
    merkurmedium, 1. Juni 2021
    #5
Thema:

Makro ändern auf Excel4Macro

Die Seite wird geladen...
  1. Makro ändern auf Excel4Macro - Similar Threads - Makro ändern Excel4Macro

  2. Excel Zellnamen per makro ändern

    in Microsoft Excel Hilfe
    Excel Zellnamen per makro ändern: Hallo Community, ich beschäftige mich gerade mit der Umbenennung von Zellnamen: Und zwar möchte ich auf jedem meiner Tabellenblätter (mit ein paar Ausnahmen) den Zellnamen L75 in LASTDATE ändern...
  3. Makro Hyperlink "anzuzeigender Text" ändern

    in Microsoft Excel Hilfe
    Makro Hyperlink "anzuzeigender Text" ändern: Hallo zusammen, mein Wunsch war es ein Makro zu besitzen was Tabellenname auflistet und die Tabellenblätter sortiert. Da ich keine Ahnung von Programmierung habe, habe ich mir einen Code via...
  4. Makros per Makro ändern

    in Microsoft Excel Hilfe
    Makros per Makro ändern: Hallo zusammen, ich muss in unzähligen Arbeitsmappen im Code eine Pfadanpassung vornehmen: bisher ActiveWorkbook.SaveAs Filename:="C:\Messergebnisse\Nadeln\250-001\" & Dateiname1 & "_" &...
  5. Dateinamen automatisch im Makro anpassen/ändern

    in Microsoft Excel Hilfe
    Dateinamen automatisch im Makro anpassen/ändern: Hallo zusammen! Glaub hier bin ich richtig Suche eine Möglichkeit mein erstes Makro so anzupassen, dass ein Fenster aufgeht in dem der neue Dateiname eingegeben wird und somit gleich mein Makro...
  6. Flackern bei Makro abstellen und Abfrage evtl ändern

    in Microsoft Excel Hilfe
    Flackern bei Makro abstellen und Abfrage evtl ändern: Hallo zusammen, beim ausführen des Makros flackert der Bildschirm unheimlich. Habt Ihr ne Idee wie ich das abstellen kann? Screen.Updating = false hab ich bereits eingefügt. Ein weiterer...
  7. Makro Zelleninhalt ändern

    in Microsoft Excel Hilfe
    Makro Zelleninhalt ändern: Hallo, ich versuche gerade das erste mal ein Makro zu programmieren. Ich habe mehrere Spalten in denen Zeitangaben in folgendem Format stehen 002h 47m (bzw 015h 15 m) und das würde ich gerne zu...
  8. bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern

    in Microsoft Excel Hilfe
    bestehendes Tabellenblatt-kopier-Makro auf Spalten-kopieren ändern: Hallo, ich habe da eine (hoffentlich)klene Frage: Ich abe ein Makro im Internet gefunden das bisher meinen Wünschen entspricht. Das Makro kopiert ganze Tabellenblätter aus mehreren Dateien in...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden