遍歷工作表

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（只需添加到您的所有模塊的頂部）執行的變量聲明一個非常好的主意。如果不這樣做，可能會導致更嚴格的時間追蹤某些錯誤，而這些錯誤在運行時纔會被捕獲。