Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
27.10.2014 22:53:06 |
trayx |
|
|
|
28.10.2014 09:20:44 |
Gast45720 |
|
|
|
28.10.2014 21:20:42 |
trayx |
|
|
|
29.10.2014 15:03:12 |
Gast7683 |
|
|
|
04.11.2014 13:42:41 |
trayx |
|
|
zum Bleistift so ? |
04.11.2014 22:09:30 |
Gast7381 |
|
|
Von:
Gast7381 |
Datum:
04.11.2014 22:09:30 |
Views:
497 |
Rating:
|
Antwort:
|
Thema:
zum Bleistift so ? |
Option Explicit
Dim oWbTarget As Workbook 'Bewerberliste
Dim oWbSource As Workbook 'jede Beurteilungsmappe
Dim oWsh As Worksheet 'jede Tabelle dazu
Dim rngFound As Range 'Treffer Bewerber in Liste
'zum Test wurde [A1] bzw. [A:A] gewählt - also anpassen !!!!!!!!!!!!!!!!!!!!!
Sub DurchDateiliste()
Dim strPath As String 'Pfad zu Mappen
Dim strMask As String 'Dateimaske
Dim strFile As String 'Datei finden
Application.ScreenUpdating = False
strPath = "E:\Temp\"
strMask = "*.xls?"
strFile = Dir(strPath & strMask) 'Pfad zu Mappen
If Len(strFile) = 0 Then Exit Sub
Set oWbTarget = ThisWorkbook
strFile = strPath & strFile
DurchArbeitsmappe strFile 'Mappe auswerten
Do
strFile = Dir()
If Len(strFile) = 0 Then Exit Do
strFile = strPath & strFile
DurchArbeitsmappe strFile 'Mappe auswerten
Loop
Application.ScreenUpdating = True
End Sub
Private Sub DurchArbeitsmappe(ByVal Dateipfad As String)
Set oWbSource = Workbooks.Open(Dateipfad)
For Each oWsh In oWbSource.Sheets
If BewerberinListe(oWsh.Index) Then 'prüfe ob Wert in [A1] in Liste [A:A]
Mittelwert 'bilde Mittelwert
End If
Next oWsh
oWbSource.Close False
End Sub
Private Sub Mittelwert() 'Kriterien selbst festlegen
Dim rngMustHave As Range 'hier nur als Test ...
Set rngMustHave = oWsh.UsedRange '... alles rechts von [A1]
Set rngMustHave = rngMustHave.Offset(0, 1).Resize(rngMustHave.Rows.Count, _
rngMustHave.Columns.Count - 1)
rngFound.Offset(0, 1).Value = _
WorksheetFunction.Average(rngMustHave) 'Mittelwert neben Bewerber in Liste
'
' weitere, erforderliche Aktionen, was mit Mittelwert so soll !!!!!!!!!!!!!!!!!!!!!
'
End Sub
Function BewerberinListe(ByVal TabIndex As Long) As Boolean
Set rngFound = oWbTarget.Sheets(1).Range("A:A").Find(oWbSource.Sheets(TabIndex).Range("A1").Value)
If Not rngFound Is Nothing Then BewerberinListe = True
End Function
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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
|
|
27.10.2014 22:53:06 |
trayx |
|
|
|
28.10.2014 09:20:44 |
Gast45720 |
|
|
|
28.10.2014 21:20:42 |
trayx |
|
|
|
29.10.2014 15:03:12 |
Gast7683 |
|
|
|
04.11.2014 13:42:41 |
trayx |
|
|
zum Bleistift so ? |
04.11.2014 22:09:30 |
Gast7381 |
|
|