遍历工作表

Question

感谢@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 

Answer 1

您绝对不会更改for语句中的工作表，因此DoSQL子句总是从同一工作表中抽取数据。您可能需要选择循环中的当前工作表，或将当前数据传递给DoSQL子项以供使用。

这应该可以解决这个问题：

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

Answer 2

作为替代Ripster's answer，你可以在current片传递给DoSQL子...

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

，改变你的子匹配。 ..

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（只需添加到您的所有模块的顶部）执行的变量声明一个非常好的主意。如果不这样做，可能会导致更严格的时间追踪某些错误，而这些错误在运行时才会被捕获。