代码在中断模式下仅 运行 正确
code does only run correctly in break mode
为了找到修复代码错误的提示，我在网上搜索了数小时和数天之后，我对可能发生的事情一无所知，希望能从这个社区得到一些建议。
代码有些复杂，因此我不会添加任何片段，而是尽可能简单地解释。
- 我创建了一个工具（excel 宏），可以对使用我们的软件（主要是多个用户）在客户站点收集的特定数据进行大量分析
- 此工具 运行多年来一直很好，包括例如过滤以仅考虑符合特定条件的用户
- 我想以某种方式扩展该工具，使其自动 运行s 多次 - 每个用户一次。
它的工作方式是：
该工具处理来自第一个用户的数据，并将结果保存为新的 excel 电子表格（其中代码继续 运行）。
该工具处理来自下一个用户的数据，并再次将结果保存为新的电子表格，依此类推。
在第二个 运行 中发生了奇怪的行为：如果 运行 在常规模式下，代码会因错误而中断；如果代码在产生错误的行之前被 'stop' 中断并且代码继续完成，则一切正常。
问题发生在分配 table 作为范围时：
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(shtName).Range(tableName & "[[#All],[" & header & "]]")
从第二个 运行 开始，以 Set... 开头的行产生错误（应用程序定义或对象定义的错误）。
这个作业在第一个 运行 中完美运行的事实让我相信对工作簿或类似的东西有某种未指定的作业，但我测试了所有选项并且可以排除这种情况；
真正令人吃惊的是，如前所述，当我在前面添加 "stop" 时，代码运行得非常好。
实在是没脑子了，欢迎大家回答！
提前谢谢你，
亚历山大
我会尝试添加一些代码。
问题出在模块sortTable（"code here"之后的相关部分，我一直用这种"template"来设置一些标准的东西：
Sub sortTable(sheetName As String, tableName As String, header As String, dir As XlSortOrder)
' here only logging and error handling settings
'---------------------------------------------------------------------------------------
' code here
'---------------------------------------------------------------------------------------
' deal with @-sign in header
Dim headerParts() As String
headerParts = Split(header, "@")
Dim cleanHeader As String
If UBound(headerParts) = -1 Then
successcode = 2
GoTo errorHandler
ElseIf UBound(headerParts) = 0 Then
cleanHeader = header
Else
cleanHeader = headerParts(0)
Dim i As Integer
For i = 1 To UBound(headerParts)
cleanHeader = cleanHeader & "'@" & headerParts(i)
Next i
End If
' sorting
Dim actWBK As String
actWBK = ActiveWorkbook.name
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort.SortFields _
.Clear
ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort.SortFields _
.Add key:=Range(tableName & "[[#All],[" & cleanHeader & "]]"), SortOn:=xlSortOnValues, Order _
:=dir, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort
.header = xlYes
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'---------------------------------------------------------------------------------------
' sub cleanup on exit; don't make changes below this line
'---------------------------------------------------------------------------------------
' here only logging and error handling
End Sub
该过程是从一个名为 QuickSort 的不同模块调用的，该模块将数组作为参数：
Public Sub QuickSort(vArray As Variant)
' here only logging and error handling
Dim wsName As String
wsName = "tempSort"
Application.DisplayAlerts = False
On Error Resume Next
Sheets(wsName).Delete
On Error GoTo errorHandler
Application.DisplayAlerts = True
Worksheets.Add After:=Sheets(Sheets.count)
ActiveSheet.name = wsName
Cells(1, 1) = "Header"
Dim rr As Range
Set rr = Range(Cells(2, 1), Cells(UBound(vArray) + 2 - LBound(vArray), 1))
Set rr = rr.Resize(UBound(vArray) + 1 - LBound(vArray), 1)
rr.value = myTransposeArray(vArray)
Set rr = Nothing
ActiveSheet.ListObjects.Add( _
xlSrcRange, _
Range(Cells(1, 1), Cells(UBound(vArray) + 2 - LBound(vArray), 1)), _
, xlYes).name = "tempSortTable"
sortTable sheetName:=wsName, tableName:="tempSortTable", header:="Header", dir:=xlAscending
' more code hereafter
尝试改变这个
Dim actWBK As String
actWBK = ActiveWorkbook.name
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
至
Dim actWbk as workbook
Set actwbk = activeworkbook
dim ws as worksheet
set ws = actwbk.worksheets(sheetname)
dim s as string
s = tableName & "[[#All],[" & cleanHeader & "]]"
Dim rr as range
Set rr = ws.range(s)
然后当它坏了你可以依次检查它们是否指向你认为它们应该指向的地方
我的一个同事找到了解决这个问题的方法（所有功劳都归功于你，Thomas！）：
而不是将范围引用为
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
我把代码改成了
Set rr = Workbooks(actWBK).Worksheets(sheetName).ListObjects(tableName).ListColumns(cleanHeader).Range
至此，无论是在第一个 运行 还是在随后的 运行 中，一切都完美无缺。
也有人怀疑是什么导致了这个问题（这个问题本身显然没有解决，这个解决方案只是一种解决方法！），它与使用 SaveAs 保存工作簿时发生的事情有关。
我完全不清楚这可能是什么原因，但是对于那些遇到类似问题的人，我想解释一下我在代码中所做的事情：
通过打开包含该工具的文件
AnalysisTool.xlsm
宏开始 运行ning。为了获取数据，代码打开一个 xml 文件作为 excel table；这个 table 暂时被称为
Book1.xlsx
代码将数据从Book1复制到AnalysisTool；为了保持工具不变，文件保存为
AnalysisResult_20180222_01.xlsm <- 这是执行代码的文件！
Book1 已关闭且未保存。
分析完成后，保存工作簿，无需关闭。
在 re-run、
删除AnalysisResult_20180222_01.xlsm中的所有结果标签，打开一个新的xml数据文件，复制数据，code-bearing文件另存为
AnalysisResult_20180222_02.xlsm <- 这是现在执行代码的文件！
等等
正如我所说，我不确定哪里出了问题，但是按照描述更改这一行会使一切正常。
希望对大家有所帮助！
为了找到修复代码错误的提示，我在网上搜索了数小时和数天之后，我对可能发生的事情一无所知，希望能从这个社区得到一些建议。
代码有些复杂，因此我不会添加任何片段，而是尽可能简单地解释。
- 我创建了一个工具（excel 宏），可以对使用我们的软件（主要是多个用户）在客户站点收集的特定数据进行大量分析
- 此工具 运行多年来一直很好，包括例如过滤以仅考虑符合特定条件的用户
- 我想以某种方式扩展该工具，使其自动 运行s 多次 - 每个用户一次。
它的工作方式是： 该工具处理来自第一个用户的数据，并将结果保存为新的 excel 电子表格（其中代码继续 运行）。 该工具处理来自下一个用户的数据，并再次将结果保存为新的电子表格，依此类推。
在第二个 运行 中发生了奇怪的行为：如果 运行 在常规模式下，代码会因错误而中断；如果代码在产生错误的行之前被 'stop' 中断并且代码继续完成，则一切正常。
问题发生在分配 table 作为范围时：
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(shtName).Range(tableName & "[[#All],[" & header & "]]")
从第二个 运行 开始，以 Set... 开头的行产生错误（应用程序定义或对象定义的错误）。
这个作业在第一个 运行 中完美运行的事实让我相信对工作簿或类似的东西有某种未指定的作业，但我测试了所有选项并且可以排除这种情况；
真正令人吃惊的是，如前所述，当我在前面添加 "stop" 时，代码运行得非常好。
实在是没脑子了，欢迎大家回答！
提前谢谢你，
亚历山大
我会尝试添加一些代码。 问题出在模块sortTable（"code here"之后的相关部分，我一直用这种"template"来设置一些标准的东西：
Sub sortTable(sheetName As String, tableName As String, header As String, dir As XlSortOrder)
' here only logging and error handling settings
'---------------------------------------------------------------------------------------
' code here
'---------------------------------------------------------------------------------------
' deal with @-sign in header
Dim headerParts() As String
headerParts = Split(header, "@")
Dim cleanHeader As String
If UBound(headerParts) = -1 Then
successcode = 2
GoTo errorHandler
ElseIf UBound(headerParts) = 0 Then
cleanHeader = header
Else
cleanHeader = headerParts(0)
Dim i As Integer
For i = 1 To UBound(headerParts)
cleanHeader = cleanHeader & "'@" & headerParts(i)
Next i
End If
' sorting
Dim actWBK As String
actWBK = ActiveWorkbook.name
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort.SortFields _
.Clear
ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort.SortFields _
.Add key:=Range(tableName & "[[#All],[" & cleanHeader & "]]"), SortOn:=xlSortOnValues, Order _
:=dir, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName).Sort
.header = xlYes
.MatchCase = True
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'---------------------------------------------------------------------------------------
' sub cleanup on exit; don't make changes below this line
'---------------------------------------------------------------------------------------
' here only logging and error handling
End Sub
该过程是从一个名为 QuickSort 的不同模块调用的，该模块将数组作为参数：
Public Sub QuickSort(vArray As Variant)
' here only logging and error handling
Dim wsName As String
wsName = "tempSort"
Application.DisplayAlerts = False
On Error Resume Next
Sheets(wsName).Delete
On Error GoTo errorHandler
Application.DisplayAlerts = True
Worksheets.Add After:=Sheets(Sheets.count)
ActiveSheet.name = wsName
Cells(1, 1) = "Header"
Dim rr As Range
Set rr = Range(Cells(2, 1), Cells(UBound(vArray) + 2 - LBound(vArray), 1))
Set rr = rr.Resize(UBound(vArray) + 1 - LBound(vArray), 1)
rr.value = myTransposeArray(vArray)
Set rr = Nothing
ActiveSheet.ListObjects.Add( _
xlSrcRange, _
Range(Cells(1, 1), Cells(UBound(vArray) + 2 - LBound(vArray), 1)), _
, xlYes).name = "tempSortTable"
sortTable sheetName:=wsName, tableName:="tempSortTable", header:="Header", dir:=xlAscending
' more code hereafter
尝试改变这个
Dim actWBK As String
actWBK = ActiveWorkbook.name
Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
至
Dim actWbk as workbook
Set actwbk = activeworkbook
dim ws as worksheet
set ws = actwbk.worksheets(sheetname)
dim s as string
s = tableName & "[[#All],[" & cleanHeader & "]]"
Dim rr as range
Set rr = ws.range(s)
然后当它坏了你可以依次检查它们是否指向你认为它们应该指向的地方
我的一个同事找到了解决这个问题的方法（所有功劳都归功于你，Thomas！）：
而不是将范围引用为
Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")
我把代码改成了
Set rr = Workbooks(actWBK).Worksheets(sheetName).ListObjects(tableName).ListColumns(cleanHeader).Range
至此，无论是在第一个 运行 还是在随后的 运行 中，一切都完美无缺。
也有人怀疑是什么导致了这个问题（这个问题本身显然没有解决，这个解决方案只是一种解决方法！），它与使用 SaveAs 保存工作簿时发生的事情有关。
我完全不清楚这可能是什么原因，但是对于那些遇到类似问题的人，我想解释一下我在代码中所做的事情：
通过打开包含该工具的文件
AnalysisTool.xlsm
宏开始 运行ning。为了获取数据，代码打开一个 xml 文件作为 excel table；这个 table 暂时被称为
Book1.xlsx
代码将数据从Book1复制到AnalysisTool；为了保持工具不变，文件保存为
AnalysisResult_20180222_01.xlsm <- 这是执行代码的文件！
Book1 已关闭且未保存。
分析完成后，保存工作簿，无需关闭。
在 re-run、
删除AnalysisResult_20180222_01.xlsm中的所有结果标签，打开一个新的xml数据文件，复制数据，code-bearing文件另存为
AnalysisResult_20180222_02.xlsm <- 这是现在执行代码的文件！
等等
正如我所说，我不确定哪里出了问题，但是按照描述更改这一行会使一切正常。
希望对大家有所帮助！