VBA循环文件夹公式粘贴问题

时间:2016-06-27 15:39:30

标签: excel vba excel-vba

我编写了一个宏,可以成功遍历文件夹,将信息复制并粘贴到新工作簿中,并插入三个公式。但是,我遇到了一些问题,我认为某些宏中的索引功能无法正确显示。

Sub LoopAllExcelFilesInFolder()

Application.ScreenUpdating = False

Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\myname\Desktop\Test Files"
MyFile = Dir(MyFolder & "\*.xlsx")

'This is where my loop code starts
Do While MyFile <> "" 
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=0
Sheets("Report").Activate
Sheets("Report").Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Selection.Copy
ActiveWorkbook.Close True
Windows("Database Loop Test.xlsm").Activate
Sheets("PORT").Activate
Range("A1").Select
ActiveSheet.Paste
'It is successfully pasted to the desired workbook

'Here I call macros that insert sum, mid, and index functions. Sum and mid work but index doesn't
Call icvba
Call iovba
Call idvba

MyFile = Dir
Loop
End Sub

奇怪的是,当我运行宏后检查索引函数时,它们都是正确的。它显示为#N / A,而不是显示正确的数字。这是我调用的宏的代码。这三个代码都是一样的;只有工作表被更改。

Sub icvba()

Worksheets("COMMIT").Activate

Dim source As Worksheet
Dim detntn As Worksheet
Dim EmptyColumn As Long
Dim LastRow As Long

Set source = Sheets("vlookup")
Set detntn = Sheets("COMMIT")

LastColumn = detntn.Cells(1, detntn.Columns.Count).End(xlToLeft).Column
LastRow = Worksheets("COMMIT").Range("A:A").Rows.Count


'This if statement inputs the troublesome index function
If detntn.Range("A2") <> "" Then
EmptyColumn = LastColumn + 1
detntn.Cells(3, EmptyColumn).Formula = "=INDEX(PORT!$S$5:$S$4000,MATCH(COMMIT!$G3,PORT!$G$5:$G$4000,0))"
LastRow = ActiveSheet.UsedRange.Rows.Count
detntn.Cells(3, EmptyColumn).AutoFill    destination:=detntn.Range(detntn.Cells(3, EmptyColumn), detntn.Cells(LastRow,    EmptyColumn))
End If


'This if statement inputs the mid function
If detntn.Range("A2") <> "" Then
detntn.Cells(2, EmptyColumn).Formula = "=MID(PORT!$A$2,7,50)"
End If


'This if statement inputs a sum function
If detntn.Range("A2") <> "" Then
Worksheets("vlookup").Activate
ActiveSheet.Range("A1").Select
Selection.Copy
Worksheets("COMMIT").Activate
detntn.Cells(1, EmptyColumn).Select
Selection.PasteSpecial Paste:=xlAll
End If

Columns(EmptyColumn).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

End Sub

此外,当我单独调用icvba,iocba,idvba宏时,它们可以完美地工作。只有当我在循环函数中调用它们才会停止工作时。

这是我用VBA编写的第一个循环,所以我可能会遗漏一些简单的东西。我无法弄清楚我哪里出错了。任何帮助将不胜感激!

1 个答案:

答案 0 :(得分:0)

听起来好像没有计算出的公式 - 尝试在复制之前将其放在最后:

Not_Calculated: 
Application.Wait(Now + TimeValue("0:00:04")) if not
Application.CalculationState = xlDone then goto Not_Calculated

这基本上会暂停宏进一步持续4秒以完成计算,如果它还没有再等4秒