Question

经过数小时和数天的网络搜索，以便找到如何修复我的代码中的错误的提示，我对可能发生的事情完全一无所知，并希望从这个社区获得一些建议。

代码有点复杂，因此我不会添加任何代码片段，而是尝试解释尽可能简单。

我创建了一个工具（excel宏），对使用我们的软件（主要是多个用户）在客户站点收集的某些数据进行了大量分析。
此工具运行良好多年，包括例如过滤以仅考虑符合特定条件的用户
我想以某种方式扩展该工具，以便它自动运行多次 - 每个用户一次。

这种方式的工作方式是：该工具处理来自第一个用户的数据，并将结果保存为新的Excel电子表格（代码继续运行）。该工具处理来自下一个用户的数据，并再次将结果保存为新的电子表格，等等。

在第二次运行中，会发生奇怪的行为：如果以常规模式运行，代码会因错误而中断;如果代码在产生错误的行之前被“停止”中断并且代码完成继续进行，那么一切都很好。

将表分配为范围时会出现问题：

Dim rr As Range
Set rr = Workbooks(actWBK).Worksheets(shtName).Range(tableName & "[[#All],[" & header & "]]")

从第二次运行开始，以Set ...开头的行会产生错误（应用程序定义或对象定义的错误）。

这项任务在第一次运行中完美运行这一事实使我相信对工作簿等有某种未指定的赋值，但我测试了所有选项并可以排除这种情况;

真正令人震惊的是，如前所述，当我之前添加“停止”时，代码完全正常。

我真的没有任何想法，所以每个答案都非常受欢迎！

提前谢谢你，

亚历山大

我会尝试添加一些代码。问题发生在模块sortTable（“代码在这里”之后的相关部分，我总是使用这种“模板”来设置一些标准的东西）：

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

Answer 1

尝试更改此

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)

然后当它打破时，你可以轮流检查每一个，看看它们是否指向你认为应该

Answer 2

我的一位同事找到了解决这个问题的解决方法（所有信用卡，托马斯！）：

而不是将范围引用为

Set rr = Workbooks(actWBK).Worksheets(sheetName).Range(tableName & "[[#All],[" & cleanHeader & "]]")

我将代码更改为

Set rr = Workbooks(actWBK).Worksheets(sheetName).ListObjects(tableName).ListColumns(cleanHeader).Range

通过这种方式，无论是在第一次运行还是在后续运行中，一切都运行良好。

还有一个怀疑可能导致问题的原因（显然本身没有解决，这个解决方案只是一个解决方法！），它与使用SaveAs保存工作簿期间发生的事情有关。

我不清楚这可能是什么原因，但对于那些面临类似问题的人，我想解释一下我在代码中所做的事情：

打开包含该工具的文件

AnalysisTool.xlsm

宏开始运行。为了获取数据，代码打开一个xml文件作为excel表;暂时将此表称为

Book1.xlsx

代码将数据从Book1复制到AnalysisTool;为了保持工具不变，文件保存为

AnalysisResult_20180222_01.xlsm＆lt; - 这是执行代码的文件！

Book1已关闭但未保存。

分析完成后，工作簿将保存而不会关闭。

重新运行时，

删除AnalysisResult_20180222_01.xlsm中的所有结果选项卡，打开新的xml数据文件，复制数据，并将代码承载文件另存为

AnalysisResult_20180222_02.xlsm＆lt; - 这是现在执行代码的文件！

等

正如我所说，我不确定会出现什么问题，但如上所述改变这一行会让一切都运转良好。

希望这对任何人都有帮助！

代码只能在中断模式下正确运行

2 个答案: