Excel 如何修复错误-“；模块'中的访问冲突；ntdll.dll'&引用；？VBA代码崩溃

我需要按客户和每个客户的贷款拆分收到的付款数据，并将这些数据保存到不同文件夹中的不同excel文件中。让我详细解释一下

数据描述：有一个大约15万行的excel文件，其中包含不同客户的不同贷款付款。1客户可能有几种不同的贷款

1） 为每个客户端创建一个以客户端ID为名称的文件夹。 2） 为每笔贷款创建一个单独的excel文件，并仅包括该贷款的过滤付款。将此excel文件与贷款ID名称一起保存在客户ID文件夹下。（是的，某些文件夹将包含多个excel文件）

我对编码是新手，所以在谷歌和youtube上做了很多工作后，我想出了下面的代码

我在数据表中有大约12列。B列-贷款ID 列C-客户端ID

我复制设置表中的这两列并删除贷款ID上的重复项，因为我需要为每个贷款ID创建单独的excel文件

然后，打开一个新工作簿，逐个复制整个数据，并创建一个以客户机ID为名称的文件夹 -

该代码实际上非常有效，但只适用于小数据。它开始创建文件夹并保存excels，但在创建大约283个文件夹后崩溃。错误如下：

“模块“ntdll.dll”中地址00007FFE7E3EBE6B处存在访问冲突。写入地址00000000000000 24。”

我已经测试过多次，有时它会因为内存不足而崩溃。我猜我需要对它进行一点优化，这样它会占用更少的资源。你能帮帮我吗

附言

---

我认为它在一行中崩溃了-

Set nwb=workbook.add

结果是打开了太多的新工作簿并关闭了它们。这似乎太过分了。因此，我没有在循环中创建新的工作簿，而是在它之前创建了一个，然后在循环中清除它。代码变得更快，工作也很好

Sub Split_excel_into_folders()Set data_sh = ThisWorkbook.Sheets("Data")
Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")
Dim nwb As Workbook
Dim nsh As Worksheet
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
''''' Get unique loan ids
setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("B:C").Copy setting_Sh.Range("A1")
setting_Sh.Range("A:B").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_Sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 2, setting_Sh.Range("A" & i).Valuedata_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.UsedRange.EntireColumn.ColumnWidth = 25
Dim path As String
Dim Folder As String
path = setting_Sh.Range("H6").Value & "\" & setting_Sh.Range("B" & i).Value
Folder = Dir(path, vbDirectory)
If Folder = VBA.vbNullString Then
VBA.MkDir (path)
End If
nwb.SaveAs setting_Sh.Range("H6").Value & "\" & setting_Sh.Range("B" & i).Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
nsh.Range("A:AA").Clear
data_sh.AutoFilterMode = False
Next i
setting_Sh.Range("A:B").Clear
nwb.Close False
MsgBox "Done"
End Sub

---

我相信mkdir最多有260个字符，所以这可能就是为什么Crassesi不认为这是个问题。如果mkdir中的名称超过260个字符，那么是的，但这里的问题是，在创建280个文件夹后是快照（我个人认为这与内存有关，因为excel有点弱），我认为这不是问题所在，但是将Dim路径作为字符串Dim文件夹作为字符串放在循环之外。您说付款列表中有150k行。你查过有多少贷款吗？您已将Dim i声明为整数，最大值为32768。在任何情况下，将其更改为

Dim i，只要

。@LuisCurado我试过了，运气不好。我检查了一下，它在这里崩溃了

nwb=workbooks.add

我假设它在打开大量工作簿（例如book1、book2、book3…..book280等）时有问题。我认为这有某种限制

Sub Split_excel_into_folders()Set data_sh = ThisWorkbook.Sheets("Data")
Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")
Dim nwb As Workbook
Dim nsh As Worksheet
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
''''' Get unique loan ids
setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("B:C").Copy setting_Sh.Range("A1")
setting_Sh.Range("A:B").RemoveDuplicates 1, xlYes
Dim i As Integer
For i = 2 To Application.CountA(setting_Sh.Range("A:A"))
data_sh.UsedRange.AutoFilter 2, setting_Sh.Range("A" & i).Valuedata_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.UsedRange.EntireColumn.ColumnWidth = 25
Dim path As String
Dim Folder As String
path = setting_Sh.Range("H6").Value & "\" & setting_Sh.Range("B" & i).Value
Folder = Dir(path, vbDirectory)
If Folder = VBA.vbNullString Then
VBA.MkDir (path)
End If
nwb.SaveAs setting_Sh.Range("H6").Value & "\" & setting_Sh.Range("B" & i).Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
nsh.Range("A:AA").Clear
data_sh.AutoFilterMode = False
Next i
setting_Sh.Range("A:B").Clear
nwb.Close False
MsgBox "Done"
End Sub