vba- Mappe öffnen & aktualisieren
21.01.2019 09:03:27
Fred
Guten Morgen Excel-Profis,
Franz hat mir am Sonntag ein vba geschrieben, welches auch wunderbar funktioniert.
Es werden im Ordner "Auswertung" Mappen geöffnet und aus den Blättern 1-9 bestimmte Daten gezählt ....
Sub Zaehlen_H5_extern_visible()
'sichtbare Zellen in Zellbereich in externen Dateien auswerten
Dim varSuch, dblZaehler As Double
Dim wkb As Workbook, wks As Worksheet
Dim rngCount As Range, Zelle As Range, rngResult As Range
Dim varFiles(), varFile, strPath, intF As Integer
Dim StatusCalc As Long
With ActiveSheet
Set rngResult = .Range("A1") 'Ergebnis-Zelle
varSuch = .Range("H5").Value 'Suchwert
End With
'makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Verzeichnis mit zu durchsuchenden Zellen
strPath = ActiveWorkbook.Path & "\Auswertung"
'Excel-Dateien im Verzeichnis suchen
varFile = VBA.Dir(strPath & "\*.xls*")
intF = 0
Do Until varFile = ""
intF = intF + 1
ReDim Preserve varFiles(1 To intF)
varFiles(intF) = strPath & "\" & varFile
varFile = Dir
Loop
If intF = 0 Then
MsgBox "Keine Excel-Dateien in Verzeichnis" & vbLf & strPath
GoTo Beenden
End If
dblZaehler = 0
'Dateien abarbeiten
For intF = 1 To UBound(varFiles)
Set wkb = Application.Workbooks.Open(varFiles(intF), ReadOnly:=True)
For Each wks In wkb.Worksheets
Select Case wks.Name
Case "1", "2", "3", "4", "5", "6", "7", "8", "9"
'auszuwertender Zellbereich
With wks
'wenn Daten in 2. Spalte einer Tabelle (Listobject) stehen
Set rngCount = .ListObjects(1).DataBodyRange.Columns(2)
'Alternative, wenn Daten in Spalte B des Tabellenblatts stehen
' Set rngCount = .Range(.Cells(1, 2), .Cells(.UsedRange.Row + .UsedRange. _
Rows.Count - 1, 2))
End With
'sichtbare Zellen im Bereich auswerten
For Each Zelle In rngCount.Cells
If Zelle.EntireRow.Hidden = False Then
If Zelle.Value Like varSuch Then
dblZaehler = dblZaehler + 1
End If
End If
Next
End Select
Next
'Datei wieder schliessen
Set rngCount = Nothing
Set wks = Nothing
wkb.Close savechanges:=False
Set wkb = Nothing
Next
rngResult.Value = dblZaehler
Erase varFiles
Beenden:
'makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
End Sub
Im nachhinein hat sich allerdings ein wohl kleineres Problem herraus gestellt.
Die im Ordner "Auswertung" zu öffnenden Mappen bzw. Arbeitsblätter beinhalten Tabellen die in Verbindung einer Datenbank stehen.
Habe ich also nicht zuvor die Mappen geöffnet und aktualisiert, sucht das Makro in nicht aktuellen Daten. (obwohl bei Verbindungen, Eigenschaften "Daten beim öffnen der Datei aktualisieren" angekreuzt ist)
Ich weis nicht, wo und was ich an dem vba ändern muss, damit es beim öffnen aktualisiert.
Irgendwo ein "refresh", "Application.AskToUpdateLinks = True" rein, oder im anderen Modus öffnen?
Kann mir jemand vielleicht einen Tip geben!?
Mit freundlichen Gruß
Fred Neumann