AW: Verknüpfung mit VBA
03.07.2011 21:42:35
fcs
Hallo Chris,
falls du die Lösung für deine vorherige Frage noch nicht hast:
Zellwerte kannst du wie folgt per INDIREKT übernehmen.
=INDIREKT("'[Bilanzarbeiten.xls]Saldenliste'!Z"&ZEILE(B5)&"S"&SPALTE(B5);FALSCH)
oder
=INDIREKT("'[Bilanzarbeiten.xls]Saldenliste'!"&ZELLE("adresse";A5))
Bei deinem Makro muss du dann die Arbeitsmappen mit in die Objektadressierung einbauen und es muss geprüft werden ob die Datei mit der zu durchsuchenden Tabelle schon geöffnet ist. Zweckmäßiger Weise verwendet man hierzu entsprechende Objektvariablen. Die gefundenen Werte muss man nicht unbedingt in Variablen zwischenspeichern. Die Werte in der Quelltabelle kann man auch direkt in die Zieltabelle übertragen.
Gruß
Franz
Private Sub CommandButton1_Click()
'Deklaration der Variablen
Dim wbZiel As Workbook, wbQuelle As Workbook, sQuelldatei As String
Dim wksZiel As Worksheet, wksQuelle As Worksheet
Dim Zeile As Long, Einfuegezeile As Long, TabellenBeginn As Long, Tabellengroesse As Long
'Bedingtes Kopieren
On Error GoTo Fehler
'Zieldatei - in diese Datei wird kopiert
Set wbZiel = ActiveWorkbook 'oder = Thisworkbook
Einfuegezeile = 3 ' Ab dieser Zeile werden die Daten eingefügt
TabellenBeginn = 3 ' Ab hier beginnt die Suche nach x
Set wksZiel = wbZiel.Worksheets("Bilanzarbeiten") ' In dieses Tabellenblatt wird kopiert
'Nächste Einfügezeile in Zieltabelle
With wksZiel
Einfuegezeile = Application.WorksheetFunction.Max(Einfuegezeile, _
.Cells.SpecialCells(xlCellTypeLastCell).Row + 1)
End With
sQuelldatei = "Saldenliste sowie alle Buchungen.xls" 'Name der Quelldatei
'Prüfen ob Quelldatendatei schon geöffnet
For Each wbQuelle In Application.Workbooks
If UCase(wbQuelle.Name) = UCase(sQuelldatei) Then
'Prüfen, ob Quelldatei im gleichen Verzeichnis wie Zieldatei
If UCase(wbQuelle.FullName) = _
UCase(wbZiel.Path & Application.PathSeparator & sQuelldatei) Then
'Alles OK - Quelldatei ist geöffnet
Else
If MsgBox("Zur Zeit geöffnete Quelldatei """ & sQuelldatei _
& """ ist in einem anderen Verzeichnis gespeichert als die aktive Zieldatei." _
& vbLf & vbLf & "Die Quelldatei schliessen und korrekte Quelle öffnen?", _
vbQuestion + vbOKCancel, "Quelldatei - prüfen - öffnen") = vbOK Then
'Quelldatei schreibgeschützt öffnen
wbQuelle.Close
Set wbQuelle = Workbooks.Open( _
Filename:=wbZiel.Path & Application.PathSeparator & sQuelldatei, _
UpdateLinks:=False, ReadOnly:=True)
Else
GoTo Beenden
End If
End If
Exit For
End If
Next
If wbQuelle Is Nothing Then
'Quelldatei ist noch nicht geöffnet - Datei schreibgeschützt öffnen
Set wbQuelle = Workbooks.Open( _
Filename:=wbZiel.Path & Application.PathSeparator & sQuelldatei, _
UpdateLinks:=False, ReadOnly:=True)
End If
Set wksQuelle = wbQuelle.Worksheets("Saldoliste") ' Aus diesem Tabellenblatt wird kopiert
Application.ScreenUpdating = False ' Bildschirmanzeige ausschalten
' Hier kann die Grösse der zu prüfenden Tabelle angegeben werden
With wksQuelle
'Letzte Zeile mit Daten in Spalte 4
Tabellengroesse = .Cells(.Rows.Count, 4).End(xlUp).Row
End With
'Bedingung prüfen und kopieren
For Zeile = TabellenBeginn To Tabellengroesse
If wksQuelle.Cells(Zeile, 4) = _
"WEK" Or wksQuelle.Cells(Zeile, 4) = "WEK" Then
wksZiel.Cells(Einfuegezeile, 1) = wksQuelle.Cells(Zeile, 1) 'Spalte A --> A
wksZiel.Cells(Einfuegezeile, 2) = wksQuelle.Cells(Zeile, 2) 'Spalte B --> B
wksZiel.Cells(Einfuegezeile, 3) = wksQuelle.Cells(Zeile, 5) 'Spalte E --> C
wksZiel.Cells(Einfuegezeile, 4) = wksQuelle.Cells(Zeile, 6) 'Spalte F --> D
wksZiel.Cells(Einfuegezeile, 5) = wksQuelle.Cells(Zeile, 12) 'Spalte L --> E
wksZiel.Cells(Einfuegezeile, 6) = wksQuelle.Cells(Zeile, 18) 'Spalte R --> F
Einfuegezeile = Einfuegezeile + 1
End If
Next Zeile
Fehler:
With Err
Select Case .Number
Case 0 ' Alles ist ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
Set wbZiel = Nothing: Set wbQuelle = Nothing
Set wksZiel = Nothing: Set wksQuelle = Nothing
Application.ScreenUpdating = True 'Bildschirmanzeige wieder einschalten
End Sub