Excel循环macros早期结束，需要保持打开文件复制几个循环（不同的文件）

我对这个VBA代码有点问题

Sub upONGOING_Train1() ScreenUpdating = False 'set variables Dim rFndCell As Range Dim strData As String Dim stFnd As String Dim fCol As Integer Dim oCol As Integer Dim SH As Worksheet Dim WS As Worksheet Dim strFName As String Dim objCell As Object Set WS = ThisWorkbook.Sheets("Trains") For Each objCell In WS.Range("L3:L100") oCol = objCell.Column strFName = WS.Cells(, oCol).Offset(objCell.Row - 1, 0) On Error GoTo BLANK: 'skip macro if no train Workbooks.Open Filename:=strFName 'open ongoing report Set SH = Worksheets("Trains") 'set sheet stFnd = WS.Cells(, oCol).Offset(objCell.Row - 1, 2).Value 'set connote With SH Set rFndCell = .Range("C3:C1100").Find(stFnd, LookIn:=xlValues) If Not rFndCell Is Nothing Then fCol = rFndCell.Column WS.Cells(, oCol).Offset(objCell.Row - 1, 3).Resize(1, 6).Copy SH.Cells(, fCol).Offset(rFndCell.Row - 1, 10).Resize(1, 6).PasteSpecial xlPasteValues 'paste values in ongoing report if connote found ActiveWorkbook.Save 'save ongoing report ActiveWorkbook.Close 'close ongoing report Else 'Can't find the item End If End With BLANK: Next objCell ScreenUpdating = True End Sub 

我想要做的是 – L3中的每一行：L100

• 打开“L”列中列出的文件（如果存在或跳过下一行）并转到工作表

• 在新打开的工作表中将原始工作表栏“N”与“C3：C1100”的值匹配

• 复制“O：T”列并粘贴到打开的工作表（M：R）中的匹配值并保存

然而，当我留下2行的差距，它给了我没有find文件的错误，而不是进行下一个循环，就像只有一行丢失一样。

似乎我不能张贴图像呢。

此外，如果任何人都可以指示我如何在单元格引用中打开表单，如果它尚未打开，通常只有2个文件可用（季度末最多4个）。 当您尝试重新打开已打开的工作簿时，单击“确定”，popup的所有窗口都会非常麻烦。

如果有任何帮助，让你的头。 我有2个单独的报告，每个季度有2个客户（每次最多4个，每次最多4个），这些客户已经有了要search的名字（每本书2张）。

任何帮助将不胜感激

感谢堆

感谢那些提出build议和代码的人。 我明天就把它们拿出来，否则我只是想出了另一个想法，重新devise一些其他的代码，但是没有意识到这些代码会有所帮助。 代码基本上将我需要的东西复制到一个空白选项卡，并删除具有给定值的行 – 用一些公式来帮助sorting这将给我一个没有rest的行块到同一个目标文件。 因此，让我运行（多一点简化谢谢大家 ）循环其余的行。

Answer 1

On Error GoTo BLANK

Workbooks.Open Filename:=strFName

把上面的内容改成：

 On Error Resume Next Workbooks.Open Filename:=strFName If Err.Number <> 0 Then Goto Blank 

至于hpw保持工作簿打开，你可以把它打开（没有.close ），但是当你想打开它检查首先，如果它是开放的（即使用Workbooks("name") ），一些error handling使用相同机制如上所述，如果错误存在，那么wb还没有打开，你打开它。

最后，避免指望Active东西，如ActiveWorkbook`。 相反，要明确提到你，即：

  Set wb = Workbooks.Open(Filename:=strFName) Set SH = wb.Worksheets("Trains") 

Answer 2

要考虑只有不是空白的单元格，你可以使用Range对象的SpecialCells（）方法，并省去任何On Error GoTo语句，这应该用在一些有限的情况下（其中一个我们将在一秒钟内看到）

此外，您正在使用一些无用的长循环“循环”来引用您的相关单元格，例如：

 WS.Cells(, oCol).Offset(objCell.Row - 1, 0) 

相当于objCell本身！

还有一些这样的例子

最后，让我们来看看工作簿的打开/closures问题

你可以：

• 使用Dictionary对象存储所有打开的工作簿的名称，以便在整个macros中打开并closures所有打开的工作簿

• 采用一个辅助函数，试图在想要的工作簿（即名称是当前objCell值的那个）中设置想要的工作表（即“ objCell ），如果不成功则返回False

以上所有的代码在这个重构：

 Sub upONGOING_Train1bis() Dim rFndCell As Range Dim SH As Worksheet Dim objCell As Range Dim shtDict As New Scripting.Dictionary '<--| this is the dictionary that will store every opened workbook name as its 'keys' Dim key As Variant ' Dim dec As String '<--| do you actually need it? Application.ScreenUpdating = False With ThisWorkbook.Sheets("Trains") '<-- reference your working worksheet ' dec = .Range("L1") '<-- what's this for? in any case take it out of for loops since its value doesn't depend on current loop variables For Each objCell In .Range("L3:L100").SpecialCells(xlCellTypeConstants) '<--| loop through L3:L100 range not blank cells only If TrySetWorksheet(objCell.Value, "Trains", SH) Then '<--|Try to set the wanted worksheet in the wanted workbook: if successful it'd retrun 'True' and leave you with 'SH' variable set to the wanted worksheet shtDict(SH.Parent.Name) = shtDict(SH.Parent.Name) + 1 Set rFndCell = SH.Range("C3:C1100").Find(objCell.Offset(, 2).Value, LookIn:=xlValues, lookAt:=xlWhole) '<--| specify at least 'LookIn' and 'LookAt' parameters If Not rFndCell Is Nothing Then rFndCell.Offset(, 10).Resize(, 6).Value = objCell.Offset(, 3).Resize(, 6).Value End If Next objCell End With For Each key In shtDict.Keys '<--|loop through opened workbooks dictionary keys Workbooks(key).Close True '<--| close workbook whose name corresponds to current dictionary key Next Application.ScreenUpdating = True End Sub Function TrySetWorksheet(fileName As String, shtname As String, sht As Worksheet) As Boolean Set sht = Nothing On Error Resume Next Set sht = Workbooks(Right(fileName, Len(fileName) - InStrRev(fileName, "\"))).Worksheets(shtname) '<--| try looking for an already open workbook with wanted name and wanted sheet If sht Is Nothing Then Set sht = Workbooks.Open(fileName:=fileName).Worksheets(shtname) '<--| if not found then try opening the wanted workbook and set the wanted sheet in it TrySetWorksheet = Not sht Is Nothing '<--| set the return value to the final result of attempts at locating the wanted sheet End Function