將公式從一張表複製到另一張

Question

您好，我目前正在嘗試編寫一個程序，將很多Excel文件遷移到另一個目錄。對於這個用例，我拼湊了下面的代碼片段。搜索Excel文件中的所有鏈接，並將其寫入此文件中的另一個工作表中。

Sub LinkCheck_detail() 

Dim aLinks   As Variant 
Dim i    As Integer 
Dim ws    As Worksheet 
Dim anyWS   As Worksheet 
Dim anyCell   As Range 
Dim reportWS   As Worksheet 
Dim nextReportRow As Long 
Dim shtName   As String 
Dim bWsExists  As Boolean 


shtName = "Verknuepfungen_detail" 

'Löscht Datenblatt falls es bereits exisitiert. 
Sheets("Verknuepfungen_detail").Delete 

' Sheet mit den Verknuepfungen anlegen 
For Each ws In Application.Worksheets 
    If ws.Name = shtName Then bWsExists = True 
Next ws 

If bWsExists = False Then 
    Application.DisplayAlerts = False 
    Set ws = ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet) 
    ws.Name = shtName 
    ws.Select 
    ws.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count) 
    Application.DisplayAlerts = True 
End If 

    ' Komplettes Workbook analysieren auf Verknuepfungen 
Set reportWS = ThisWorkbook.Worksheets(shtName) 
    reportWS.Cells.Clear 
    reportWS.Range("A1") = "Sheet" 
    reportWS.Range("B1") = "Zelle" 
    reportWS.Range("C1") = "Formel" 
    reportWS.Range("A1:C1").Font.Bold = True 

    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks) 
If Not IsEmpty(aLinks) Then 

     ' Wenn Verknuepfungen gefunden dann diese in Ergebnis schreiben 
     For Each anyWS In ThisWorkbook.Worksheets 
      If anyWS.Name <> reportWS.Name Then 
       For Each anyCell In anyWS.UsedRange 
        If anyCell.HasFormula Then 
         If InStr(anyCell.formula, "[") > 0 Then 
          nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1 
          reportWS.Range("A" & nextReportRow) = anyWS.Name 
          reportWS.Range("B" & nextReportRow) = anyCell.Address 
          reportWS.Range("C" & nextReportRow) = "'" & anyCell.formula 
         End If 
        End If 
       Next 
      End If 
     Next 
    Else 
     MsgBox "Keine Verknüpfungen gefunden in der Datei." 
    End If 

    reportWS.Columns("A:C").EntireColumn.AutoFit 
    ' Zuruecksetzen der Hilfs-Variablen 
    Set reportWS = Nothing 
    Set ws = Nothing 
End Sub 

然後對路徑進行更改。

Sub ReplaceEPP4_detail() 
' Author Tobias Fandrich 
' Finden von String "oldPath" in Dateipfaden und die Ersetzung durch "newPath" 
Dim ws As Worksheet 
Dim linkList As Range 
Dim linkCell As Range 


Set ws = ActiveSheet 

' Alle Eintraege selektieren 
ws.Range("c1", ActiveSheet.Range("c1").End(xlDown)).Select 

' Selektion zu Variable 
Set linkList = Selection 

' EPP4 entfernen und gegen EZE ersetzen 
linkList.Replace "oldPath", "newPath", xlPart 

End Sub 

因此，這讓我和具有以下列的新表： 表，單元格，公式

現在我需要寫這回在那裏我得到了它從表。

Sub UpdateLinksFormula() 

    Dim ws As Worksheet 
    Dim targetWS As String 
    Dim sourceWS As String 

    Dim sourceCell As Range 
    Dim targetCell As String 
    Dim newFormula As String 
    Dim i As Integer ' Variable fuer Sheets Count 
    Dim rowCount As Integer ' Variable fuer Rows Count 
    Dim j As Integer ' Variable fuer Schleife 
    Dim bWsExists As Boolean 

    sourceWS = "Verknuepfungen_detail" 

    ' Auf Arbeitsblatt mit Verknuepfungen springen 
    For i = 1 To Sheets.Count 
     If Sheets(i).Name = sourceWS Then 
     bWsExists = True: Exit For 
    End If 
    Next i 

    If bWsExists Then 
     Sheets(sourceWS).Select 
    Else 
     Beep 
     MsgBox "Verknuepfungen_detail nicht gefunden!" 
    End If 

    ' Groesse bestimmen 
    rowCount = Range("A1").End(xlDown).Row 
    ' Debug.Print (j) 

    ' Schleife zum schreiben der aktualisierten Links 
    For j = 2 To rowCount 
     targetWS = Cells(j, 1) 
     targetCell = Cells(j, 2) 
     newFormula = Cells(j, 3) 

     Debug.Print (targetWS) 
     Debug.Print (targetCell) 
     Debug.Print (newFormula) 

     ' Pseudocode 
     ' Sheets(targetWS)!.Cell(targetCell).formula = newFormula 

     Sheets("targetWS").Range("targetCell").formula = newFormula 

    Next j 

End Sub 

事情是它只是將無法工作，我嘗試過用「」，而不等，但現在看來，這只是不會做。

我遇到的第二個問題是如何自動化這件事，以便我不更新一個Excel文件，而是更新它。

所有幫助將不勝感激。

Answer 1

Sheets(targetWS).Range(targetCell).formula = newFormula

嘗試。