简体   繁体   English

VBA:打开文件,计算,粘贴值,重复

[英]VBA: Open files, calculate, paste values, repeat

I'm trying to write a macro that will Open files one by one in a provided directory, calculate all formulas, paste values over specific formulas, save, and exit, repeat process with next file. 我正在尝试编写一个宏,该宏将在提供的目录中一个一个地打开文件,计算所有公式,将值粘贴到特定公式上,然后保存并退出,并对下一个文件重复此过程。 Here's what i have below: 这是我下面的内容:

Sub LoopPaloSnapshot()

Dim wb As Workbook
Dim ws As Worksheet
Dim MyPath As String
Dim FldrPicker As FileDialog
Dim FSO As New FileSystemObject
Dim MyFolder As Folder
Dim SubFolder As Folder
Dim MyFile2 As File

Application.ScreenUpdating = True
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    MyPath = .SelectedItems(1) & "\"
End With

Set FSO = CreateObject("scripting.filesystemobject")


'In Case of Cancel
NextCode:

MyPath = MyPath

Set MyFolder = FSO.GetFolder(MyPath)

For Each SubFolder In MyFolder.SubFolders

For Each MyFile2 In SubFolder.Files


If FSO.GetExtensionName(MyFile2.Path) = "xlsx" Then

    Set wb = Workbooks.Open(Filename:=MyFile2, UpdateLinks:=0)

    Set ws = wb.Worksheets("Staffing Model")

       Application.Run ("PALO.CALCSHEET")
       Application.Calculate
       Application.Run ("PALO.CALCSHEET")
       Application.Calculate

    Application.Calculation = xlCalculationManual

        ws.Range("B1").Select
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F10:Q10").Value = ws.Range("F10:Q10").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F20:Q22").Value = ws.Range("F20:Q22").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F42:Q43").Value = ws.Range("F42:Q43").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F56:Q56").Value = ws.Range("F56:Q56").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F61:Q61").Value = ws.Range("F61:Q61").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F66:Q66").Value = ws.Range("F66:Q66").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False

'Break Links
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    End If

Dim xWs As Worksheet
For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> "Staffing Model" Then
        xWs.Delete
    End If
Next

    'Save and Close Workbook
    wb.Close SaveChanges:=True

'Loop

End If

Next
Next

MsgBox "Task Complete!"

ResetSettings:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

After running this, i open the newly saved files and there are #Value errors in place of the formulas im attempting to calculate and paste values over. 运行此命令后,我打开新保存的文件,并出现#Value错误,而不是试图计算和粘贴值的公式。 I've tried walking through the macro line by line and it seems to be working properly for the most part, but for some reason the formulas are not calculating. 我尝试逐行浏览宏,它似乎在大多数情况下都正常工作,但是由于某些原因,该公式无法计算。 if i open the file manually prior to running the macro, everything calculates perfectly so im wondering if something is causing these formulas to not calculate while the macro is running. 如果我在运行宏之前手动打开文件,那么一切都会完美计算,因此我想知道是否是某种原因导致这些公式在宏运行时无法计算。 any help would be appreciated. 任何帮助,将不胜感激。

EDIT: the formulas im copying and pasting values over are HLOOKUP's pulling from other tabs within the workbook, and PALO formulas pulling data directly from a JEDOX server. 编辑:IM复制和粘贴值的公式是HLOOKUP从工作簿中其他选项卡中提取的,而PALO公式则是直接从JEDOX服务器中提取数据。 i've manually ran through the process im trying to automate without errors. 我已经手动执行了整个过程,试图自动执行而没有错误。

Instead of copying and pasting complex formulas, I'd suggest writing the formulas directly into the cells using this method: 建议不要使用以下方法将公式直接复制并粘贴到单元格中:

Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"

Pasted formulas can sometimes carry references to the original worksheet which causes chaos, whereas an explicitly set formula will not do that. 粘贴的公式有时会带有对原始工作表的引用,这会导致混乱,而显式设置的公式则不会这样做。

If you're really trying to take it offline then you could also use this method to set values as well. 如果您确实要使它脱机,那么也可以使用此方法来设置值。

Worksheets("Sheet1").Range("A1").Value = "100"

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM