Mittelwert bilden und auslesen

Sub Mittelwert_auslesen() Range("A2:C5002").Select Selection.ClearContents Dim Dateien As Integer Application.DisplayAlerts = False With Application.FileSearch .NewSearch .LookIn = "c:\Temp" .Filename = "*.csv" If .Execute() > 0 Then For Dateien = 1 To .FoundFiles.Count Workbooks.Open Filename:=.FoundFiles(Dateien) Workbooks(2).Close Next Dateien End If Application.DisplayAlerts = True End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Mittelwert_auslesen() Dim objDatei As Workbook Dim i As Long Dim Mittelwert As Double Dim Dateien As Integer Range("A2:C5002").ClearContents Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "c:\Temp" .Filename = "*.csv" If .Execute() > 0 Then For Dateien = 1 To .FoundFiles.Count Set objDatei = Workbooks.Open(Filename:=.FoundFiles(Dateien)) With Application.WorksheetFunction Mittelwert = .Average(objDatei.Sheets(1).Range("D26:D49")) Cells(i, "A") = Mittelwert End With objDatei.Close False Next Dateien End If End With Application.ScreenUpdating = True End Sub

Option Explicit Sub Mittelwert_auslesen() Dim objDatei As Workbook Dim i As Long Dim Mittelwert As Double Dim Dateien As Integer Range("A2:C5002").ClearContents i = 2 Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "c:\Temp" .Filename = "*.csv" If .Execute() > 0 Then For Dateien = 1 To .FoundFiles.Count Set objDatei = Workbooks.Open(Filename:=.FoundFiles(Dateien)) With Application.WorksheetFunction Mittelwert = .Average(objDatei.Sheets(1).Range("D26:D49")) Cells(i, "A") = Mittelwert i = i + 1 End With objDatei.Close False Next Dateien End If End With Application.ScreenUpdating = True End Sub

Hallo herbert,
damit man die Daten "einfach" übertragen kann müssen die involvierten Objekte sauber deklariert sein.
Nachfolgende Code-Anpassung ist nicht getestet.
Gruß
Franz


Sub Mittelwert_auslesen()
Dim wbQuelle As Workbook, wksZiel As Worksheet
Dim Dateien As Integer
Dim lngZeile As Long
Set wksZiel = ActiveSheet
wksZiel.Range("A2:C5002").ClearContents
lngZeile = 2
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "c:\Temp"
.Filename = "*.csv"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Dateien)
Set wbQuelle = ActiveWorkbook
'Mittelwert in Spalte 1
wksZiel.Cells(lngZeile, 1) = _
Application.WorksheetFunction.Average(wbQuelle.Worksheets(1).Range("D26:D49"))
'dateiname in Spalte2
wksZiel.Cells(lngZeile, 2) = wbQuelle.Name
lngZeile = lngZeile + 1
wbQuelle.Close savechanges:=False
Next Dateien
End If
Application.DisplayAlerts = True
End With
End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mittelwert bilden und auslesen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread