VBA合并Excel工作簿疑似内存不足问题求助

嘿，我懂你这种找不到解决方案的头疼——合并46个工作簿本来就够繁琐了，还要按特定的ISO货币或国家规则筛选复制工作表，确实容易卡壳。咱们来把你的代码调整一下，精准实现需求：

核心思路 #

先明确你要保留的ISO货币/国家标识（比如工作表名称就是货币代码，或者工作表里某列存着国家代码），然后在复制前加一层判断，只复制符合条件的工作表。

具体代码调整 #

1. 定义目标筛选列表 #

先把你需要的ISO货币/国家代码存成一个数组，方便后续判断：

' 替换成你实际需要的ISO货币/国家代码
Dim targetIdentifiers As Variant
targetIdentifiers = Array("USD", "EUR", "GBP", "JPY")

2. 新增判断逻辑，只复制符合条件的工作表 #

修改你原来的复制代码，加上条件判断：

' 假设这里是你遍历46个工作簿的循环内
Dim wbBank As Workbook, wbStructure As Workbook
Dim c As Variant
' （这里省略你打开wbBank和wbStructure的代码）

For Each c In wbBank.Sheets
    ' 情况1：工作表名称就是ISO货币/国家代码
    If IsInArray(c.Name, targetIdentifiers) Then
        c.Copy Before:=wbStructure.Worksheets(wbStructure.Sheets.Count)
        ' 可选：给复制后的工作表重命名，避免重名冲突
        wbStructure.Sheets(wbStructure.Sheets.Count - 1).Name = c.Name & "_" & wbBank.Name
    End If

    ' 情况2：工作表内某单元格存着ISO标识（比如A1单元格）
    ' If IsInArray(c.Range("A1").Value, targetIdentifiers) Then
    '     c.Copy Before:=wbStructure.Worksheets(wbStructure.Sheets.Count)
    ' End If
Next c

3. 辅助函数：判断值是否在数组内 #

上面用到的IsInArray需要自己定义，放在模块里就行：

Function IsInArray(valToCheck As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If element = valToCheck Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

额外注意事项 #

• 处理重名工作表：如果多个源工作簿有同名的符合条件工作表，复制时会自动加括号编号（比如USD(2)），但建议手动加前缀（比如源工作簿名称），方便后续溯源。
• 错误处理：可以给打开工作簿的代码加On Error Resume Next，避免某个工作簿损坏导致整个程序崩溃。
• 批量遍历工作簿：如果还没写遍历指定文件夹下46个工作簿的代码，可以用Dir函数循环读取文件夹里的所有Excel文件。

内容的提问来源于stack exchange，提问作者Erika