0

感谢@Tim WIlliams，我有以下代码可以生成插入语句。但是，当我添加以下子程序来调用它来遍历工作簿时，它仍然只拾取活动工作表。我究竟做错了什么？

 Sub WorksheetLoop()

   Dim WS_Count As Integer
   Dim I As Integer
   Dim current As Worksheet
   ' Set WS_Count equal to the number of worksheets in the active
   ' workbook.
   WS_Count = ActiveWorkbook.Worksheets.Count

   ' Begin the loop.
   For Each current In ActiveWorkbook.Worksheets


      Call DoSQL

      'MsgBox ActiveWorkbook.Worksheets(I).Name

   Next

   End Sub

   Sub DoSQL()
   myfile = "test.txt"
   fnum = FreeFile()
   Open myfile For Output As fnum

    Const SQL = "insert into <tbl>(<cols>) values (<vals>)"
    Dim dictSQL As Object, rw1 As Range, r As Long, rowSQL
    Dim sht As Worksheet, k, c As Range
    Dim cols, vals

    'Set sht = ActiveSheet
    Set rw1 = sht.Range(sht.Cells(1, 1), sht.Cells(1, Columns.Count).End(xlToLeft))

    Set dictSQL = tableDict(rw1)

    r = 2

    Do While sht.Cells(r, 1).Value <> ""

        For Each k In dictSQL
            rowSQL = Replace(SQL, "<tbl>", k)
            cols = ""
            vals = ""

            For Each c In dictSQL(k).Cells
               cols = cols & IIf(Len(cols) > 0, ",", "") & Split(c.Value, ".")(1)
               vals = vals & IIf(Len(vals) > 0, ",", "") & _
                             "'" & Trim(sht.Cells(r, c.Column).Value) & "'"
            Next c

            rowSQL = Replace(rowSQL, "<cols>", cols)
            rowSQL = Replace(rowSQL, "<vals>", vals)
            Debug.Print rowSQL
            Print #fnum, rowSQL
        Next k

        r = r + 1
    Loop
    Close #fnum

   End Sub

   Function tableDict(rw As Range)
    Dim rv As Object, tbl
    Set rv = CreateObject("scripting.dictionary")
    Dim c As Range
    For Each c In rw.Cells
        If Len(c.Value) > 0 And InStr(c.Value, ".") > 0 Then
            tbl = Split(c.Value, ".")(0) 'table name
            If rv.exists(tbl) Then
                Set rv(tbl) = Application.Union(c, rv(tbl))
            Else
                rv.Add tbl, c
            End If
        End If
    Next c
    Set tableDict = rv
    End Function
4

2 回答 2

1

作为Ripster 答案的替代方案，您可以将工作current表传递给DoSQLSub ...

For Each current In ActiveWorkbook.Worksheets
    DoSQL(current)
Next

并更改您的 Sub 以匹配...

Sub DoSQL(sht As Worksheet)
    myfile = "test.txt"
    fnum = FreeFile()
    Open myfile For Output As fnum

    Const SQL = "insert into <tbl>(<cols>) values (<vals>)"
    Dim dictSQL As Object, rw1 As Range, r As Long, rowSQL
    Dim k, c As Range
    Dim cols, vals

    'Your code continues...

附带说明：一般来说，使用ActiveSheet/不是一个好主意ActiveWorkbook，因为如果您的代码在执行过程中激活了不同的对象，这可能会被搞砸。为避免此问题，您应将每个工作表显式设置为对象（不使用ActiveSheet！）。“ThisWorkbook”将确保代码仅在调用代码的工作簿上运行，这是朝着正确方向迈出的一步ActiveWorkbook。

另一个注意事项：您还应该养成明确声明变量的习惯。如果未指定数据类型，Variant则使用默认类型，这将比您的简单类型（Integer等）占用更多内存。此外，允许在一行上调暗多个变量，但每个变量都必须在类型规范中。

换句话说，以下（来自您的代码）将产生 2 个变量，一个 (c) 类型Range，另一个 (k) 一个 Variant。

Dim k, c As Range

最后（然后我会离开我的肥皂盒）：使用Option Explicit（只需将其添加到所有模块的顶部）来强制声明变量是一个非常好的主意。如果不这样做，可能会导致更难追踪某些直到运行时才会被发现的错误。

于 2013-02-26T18:27:17.750 回答
0

您永远不会更改 for 语句中的工作表，因此 DoSQL 子始终从同一个工作表中提取数据。您要么需要在循环中选择当前工作表，要么将当前工作表传递给 DoSQL 子程序以供使用。

这应该可以解决问题：

   For Each current In ActiveWorkbook.Worksheets
      Current.Select
      Call DoSQL
      'MsgBox ActiveWorkbook.Worksheets(I).Name
   Next
于 2013-02-26T18:22:42.510 回答