AW: Externe Exceldatei auslesen und eintragen
19.09.2015 19:39:47
fcs
Hallo Matthias,
nachfolgend Makros für den Import.
Kopiere diese in ein allgemeines Modul deiner Datei.
Danach kannst du sie via Menü "Ansicht--Makros" starten.
Oder du legst dir im Tabellenblatt noch Schaltflächen aus den Formular-Steuerelementen an oder andere Formen und weist ihnen die Makros zu.
Gruß
Franz
Sub ImportHeim()
Call ImportSpiel(SpalteSpielerVR:=1, SpaErgebnis:=2, bolHeim:=True)
End Sub
Sub ImportAuswaerts()
Call ImportSpiel(SpalteSpielerVR:=1, SpaErgebnis:=5, bolHeim:=False)
End Sub
Function ImportSpiel(ByVal SpalteSpielerVR As Long, ByVal SpaErgebnis As Long, _
ByVal bolHeim As Boolean, Optional ByVal AnzahlSpiele As Long = 3) As Boolean
Dim varList, varDatei, wkbVR As Workbook, wksVR As Worksheet
Dim ZeiVR As Long, SpaVR As Long, Spieler As String
Dim arrDateiST As Variant, wkbST As Workbook, wksST As Worksheet
Dim SpaSpielerST As Long, ZeiST As Long
Set wkbVR = ActiveWorkbook
Set wksVR = wkbVR.Worksheets("VR")
If bolHeim = True Then
SpaSpielerST = 1
Else
SpaSpielerST = 3
End If
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Datei(en) mit " _
& IIf(bolHeim, "Heimspiel(en)", "Auswärtspiel(en)") & " auswahlen"
.AllowMultiSelect = True
If .Show = -1 Then
Set varList = .SelectedItems
Else
GoTo Beenden
End If
End With
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For Each varDatei In varList
Set wkbST = Application.Workbooks.Open(Filename:=varDatei, _
ReadOnly:=True)
Set wksST = wkbST.Worksheets(1)
Debug.Print "varDatei: " & varDatei
With wksVR
For ZeiVR = 2 To .Cells(.Rows.Count, SpalteSpielerVR).End(xlUp).Row Step 3
Spieler = .Cells(ZeiVR, SpalteSpielerVR)
If .Cells(ZeiVR + 1, SpaErgebnis + AnzahlSpiele - 1).Value "" Then
MsgBox "Für Spieler """ & Spieler _
& """ sind alle Zellen für Spielergebnisse ausgefüllt!"
Else
For SpaVR = SpaErgebnis To SpaErgebnis + AnzahlSpiele - 1
If IsEmpty(.Cells(ZeiVR + 1, SpaVR)) Then Exit For
Next SpaVR
With wksST
For ZeiST = 4 To .Cells(.Rows.Count, SpaSpielerST).End(xlUp).Row Step 3
If .Cells(ZeiST, SpaSpielerST).Value = Spieler Then
wksVR.Cells(ZeiVR + 1, SpaVR).Value = _
.Cells(ZeiST, SpaSpielerST + 1).Value
wksVR.Cells(ZeiVR + 2, SpaVR).Value = _
.Cells(ZeiST + 1, SpaSpielerST + 1).Value
Exit For
End If
Next
End With
End If
Next
End With
wkbST.Close savechanges:=False
Next varDatei
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Beenden:
End Function