Question

感谢@Tim WIlliams我有以下代码生成插入语句。但是，当我添加以下sub来调用它来travserse工作簿时，它仍然只选择活动工作表。我做错了什么？

 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

Answer 1

作为Ripster's answer的替代方案，您可以将current表格传递给DoSQL子...

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）为变体。

Dim k, c As Range

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

Answer 2

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

这应解决问题：

   For Each current In ActiveWorkbook.Worksheets
      Current.Select
      Call DoSQL
      'MsgBox ActiveWorkbook.Worksheets(I).Name
   Next

遍历工作表

2 个答案: