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シートを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また、1 行で複数の変数を淡色表示にすることは許可されていますが、それぞれの変数が型指定されている必要があります。

つまり、次の (コードから) は 2 つの変数を生成します。1 つ (c) は typeRangeで、もう 1 つ (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 に答える