Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Wert in externer Mappe suchen und mit Format übernehmen.

Gruppe

Change

Problem

Bei einer Eingabe eines Wertes in Spalte B soll dieser Wert in einer anderen Arbeitsmappe in Zeile1 und der Wert aus Spalte A dort in Spalte A gesucht werden. Die Formatierung aus der Fundzelle soll übernommen werden.

Lösung
Den nachfolgenden Code in die genannten Elemente einfügen.

ClassModule: Tabelle1

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column = 2 Then Call ReadFormatting(Target.Offset(0, -1))
End Sub

StandardModule: Modul1

Sub ReadFormatting(rng As Range)
   Dim vRow As Variant, vCol As Variant
   Dim sFile As String
   Application.ScreenUpdating = False
   sFile = ThisWorkbook.Path & "\test1.xls"
   If Dir(sFile) = "" Then
      Beep
      MsgBox "Testarbeitsmappe ist nicht vorhanden!"
      Exit Sub
   End If
   Workbooks.Open sFile, False
   Worksheets("160901").Select
   vRow = Application.Match(rng.Value, Columns(1), 0)
   vCol = Application.Match(rng.Offset(0, 1).Value, Rows(1), 0)
   If Not IsError(vRow) And Not IsError(vCol) Then
      Cells(vRow, vCol).Copy
      rng.Offset(0, 2).PasteSpecial xlPasteFormats
      Application.CutCopyMode = False
   End If
   ActiveWorkbook.Close savechanges:=False
   Application.ScreenUpdating = True
End Sub

Sub SetFormula()
   Dim sFile As String, sFormula As String
   sFile = "'" & ThisWorkbook.Path & "\[test1.xls]160901'!"
   sFormula = "=INDEX(" & sFile & "$A$1:$F$6,MATCH(A1," & _
      sFile & "A:A,0),MATCH(B1," & sFile & "1:1,0))"
   Range("C1").Formula = sFormula
End Sub