拆分列不适用于按钮

Question

为了工作，我必须从USDA报告中获取各种信息。我创建了一个子程序，它将从文本文件中提取所需信息到工作表“ USDA Weekly”中。我使用记录器创建了另一个子程序，该子程序使用文本进行列划分信息（通过固定宽度）。进行拆分的子项是唯一以任何方式更改“ USDA每周”表上信息的子项。其他所有子项都从此工作表中提取信息。

我在另一个工作表（在同一工作簿中）上有一个按钮，该按钮运行我为报表所创建的所有子项，包括提到的两个子项。现在，当我运行sub来拆分信息时，它可以完美地工作，但是当我单击按钮以运行包括拆分器的所有subs时，它不起作用。

我已经在调试器中分步运行了多次，以试图弄清为什么这种情况没有运气。我对为什么为什么单击按钮时sub无效而在单独运行时有效却感到困惑。任何关于为什么它不起作用的提示都值得赞赏。

编辑：对此无效的说明。通过按钮运行拆分子时，它根本不会拆分列，如下所示。没有错误，或任何弹出窗口。

编辑编辑：根据Mathieu Guindon（暗示）的建议，我已经修改了USDA格式，每周使用with语句来避免隐式引用。

Sub formatUSDAWeekly()
'this sub pulls information from strictly within the workbook

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook 'sets wb to the workbook that contains the code (i.e. this workbook)

Set ws = wb.Sheets("USDA Weekly")

With ws

    .Range("A:A").TextToColumns Destination:=.Range("A:A"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(39, 1), Array(50, 1), Array(52, 1), Array(61, 1), _
        Array(73, 1)), TrailingMinusNumbers:=True

End With

End Sub

这是按钮的子项

Sub start()

Call pullFrom610
Call formatUSDAWeekly
Call formatWIWorkbook
Call formatOSWorkbook

End Sub

这是提取信息的子项

Sub pullFrom610()
'this code was taken from Seamus Abshere
'on SO:https://stackoverflow.com/questions/158633/how-can-i-send-an-http-post-request-to-a-server-from-excel-using-vba

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("USDA Weekly")

ws.Columns("A:F").ClearContents 'clears the previous information

With ws.QueryTables.Add(Connection:="URL;https://www.ams.usda.gov/mnreports/lm_pk610.txt", Destination:=ws.Range("A1"))

    .RefreshStyle = xlOverwriteCells
    .SaveData = True
    .Refresh

End With

End Sub

这是使用文本将信息拆分为列的子项

Sub formatUSDAWeekly()
'this sub pulls information from strictly within the workbook

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook 'sets wb to the workbook that contains the code (i.e. this workbook)

Set ws = wb.Sheets("USDA Weekly")

ws.Range("A:A").TextToColumns Destination:=Range("A:A"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(39, 1), Array(50, 1), Array(52, 1), Array(61, 1), _
        Array(73, 1)), TrailingMinusNumbers:=True

End Sub

Answer 1

尽管Active Sheet隐式引用可能存在问题（应该更正），但最有可能的问题是，在调用formatUSDAWeekly之前查询尚未完成。

有很多解决此问题的方法，包括：

• 禁用Background Refresh .BackgroundQuery = False
• 在查询后使用DoEvents，但这并不总是有效
• 在.RefreshAll之后的空白查询中使用pullFrom610，其名称类似于zzzzzz，以便它最后运行（查询以字母顺序刷新）

Answer 2

原因可能是由于单击按钮时调用activeSheet导致pullFrom610()发生了变化。

要解决此问题，请显式调用您在Destination中的Sub formatUSDAWeekly范围。

编辑：

如@RonRosenfeld所建议的那样，存在第二个问题，即查询未及时完成其工作。解决方案是放入.BackgroundQuery = False。最终代码将如下所示：

Sub pullFrom610()
'this code was taken from Seamus Abshere
'on SO:https://stackoverflow.com/questions/158633/how-can-i-send-an-http-post-request-to-a-server-from-excel-using-vba

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("USDA Weekly")

ws.Columns("A:F").ClearContents 'clears the previous information

With ws.QueryTables.Add(Connection:="URL;https://www.ams.usda.gov/mnreports/lm_pk610.txt", Destination:=ws.Range("A1"))

    .BackgroundQuery = False
    .RefreshStyle = xlOverwriteCells
    .Refresh
    .SaveData = True

End With

End Sub

Sub formatUSDAWeekly()
'this sub pulls information from strictly within the workbook

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook 'sets wb to the workbook that contains the code (i.e. this workbook)

Set ws = wb.Sheets("USDA Weekly")

ws.Range("A:A").TextToColumns Destination:=ws.Range("A:A"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(39, 1), Array(50, 1), Array(52, 1), Array(61, 1), _
        Array(73, 1)), TrailingMinusNumbers:=True

End Sub

希望这会有所帮助。