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

事情就是它无法正常工作，我试着用“”，没有等等，但它似乎不会这样做。

我遇到的第二个问题是关于如何自动化这个Thing，这样我就不会只更新一个Excel文件而只更新数百个。

所有帮助将不胜感激。

Answer 1

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

试试这个。

将公式从一张纸复制到另一张

1 个答案: