AW: Daten aus Blatt holen...
03.11.2010 23:29:31
fcs
Hallo Robert,
zwei übliche Wege gibt:
1. Datei mit Quelldaten schreibgeschützt öffnen und Daten auslesn, Datei wieder schliessen
2. Formeln mit Verknüpfung zur Quelldatei in Zellen eintragen. Danach Werte in Variablen einlesen und Formeln wieder löschen.
Nachfolgend ein paar Beispiele.
Gruß
Franz
Sub DatenHolen()
Dim wb As Workbook, wksQuelle As Worksheet
Dim arrDaten1
Dim arrDaten2(), lSpalte&, lZeile&, lIndexZ&, lIndexS&
Dim sFData$, vFData1
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Quelldatei schreibgeschützt öffnen
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\RF-Finanzen.xlsm", _
ReadOnly:=True)
'Tabelle mit Quelldaten setzen
Set wksQuelle = wb.Worksheets("Blatt_Übersicht")
'um alle Daten des benutzten Bereichs einzulesen in ein Datenarray
'entweder so - hat bei früheren Version Probleme bei Zellen mit Datum/Zeit und Währungsformaten
arrDaten1 = wksQuelle.UsedRange
'oder - alle Zellen des benutzen Bereichs einzeln in ein Datenarray einlesen
With wksQuelle.UsedRange
'Daten-Array dimensionieren
ReDim arrDaten2(1 To .Rows.Count, 1 To .Columns.Count)
'Daten zeilenweise einlesen
For lZeile = .Row To .Row + .Rows.Count - 1
lIndexZ = lIndexZ + 1
For lSpalte = .Column To .Column + .Columns.Count - 1
lIndexS = lIndexS + 1
arrDaten2(lIndexZ, lIndexS) = wksQuelle.Cells(lZeile, lSpalte).Value
Next
lIndexS = 0
Next
End With
'um die Daten einzelner Zellen einzulesen, z.B.
sFData = wksQuelle.Range("A4")
wb.Close savechanges:=False
'Variante für Einzeldaten mit Formel in einer Zelle - hier Zelle A1
With ActiveSheet.Cells(1, 1)
.Formula = "='" & ThisWorkbook.Path & "\[RF-Finanzen.xlsm]Blatt_Übersicht'!$B$4"
.Calculate
vFData1 = .Value
.ClearContents
End With
'Test: Eintragen der ausgelesenen Daten ins aktive Tabellenblatt
With ActiveSheet
.UsedRange.ClearContents
lZeile = 0
lSpalte = 0
For lIndexZ = LBound(arrDaten1, 1) To UBound(arrDaten1, 1)
lZeile = lZeile + 1
For lIndexS = LBound(arrDaten1, 2) To UBound(arrDaten1, 2)
lSpalte = lSpalte + 1
.Cells(lZeile, lSpalte).Value = arrDaten1(lIndexZ, lIndexS)
Next
lSpalte = 0
Next
lZeile = lZeile + 1
lSpalte = 0
For lIndexZ = LBound(arrDaten2, 1) To UBound(arrDaten2, 1)
lZeile = lZeile + 1
For lIndexS = LBound(arrDaten2, 2) To UBound(arrDaten2, 2)
lSpalte = lSpalte + 1
.Cells(lZeile, lSpalte).Value = arrDaten2(lIndexZ, lIndexS)
Next
lSpalte = 0
Next
lZeile = lZeile + 2
.Cells(lZeile, 1) = "sFData"
.Cells(lZeile, 2) = sFData
lZeile = lZeile + 1
.Cells(lZeile, 1) = "vFData1"
.Cells(lZeile, 2) = vFData1
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub