質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.58%

Excelマクロで特定シートの情報からSQL文を作成したい

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 1,281

yontabaru

score 19

はじめまして。超初心者です。

ブック内に、1シート目に「変更履歴」、2シート目に「テーブル名」という2シートがあります。
複数のブック内の、2シート目「テーブル名」が書かれたシートのみをブック事に読み込んでSQLを作成したくて
いろいろと試してみましたが、2シート目の「テーブル名」だけは取得できてもシート内の項目などが取得できませんでした。

現在は、1シート目に「変更履歴」を削除して、「テーブル名」シートだけにして対応していますが、
できればマクロの方で対応したいので、2シート目の情報でSQLを作成する方法を教えてください。

Sub CREATE_TABLEのSQL作成()

Dim dstSheet As Worksheet
Set dstSheet = ThisWorkbook.Worksheets(1)

Dim Path As String
Path = Range("B13").Value & "\"  ←読み込むExcelファイルの場所を記載しています。

'入力のExcelファイル(テーブル項目)へのパス
Dim buf As String
buf = Dir(Path & "*.xls")

Dim srcBook As Workbook
Dim srcSheet As Worksheet

'出力先ファイル(全テーブル分のCreate Table文)へのパス
Dim fn As Integer
fn = FreeFile
Dim Output As String
Output = dstSheet.Range("B16").Value  ←出力するSQLファイルの場所を記載しています。

'SQL文の出力先ファイル
Open Output & "\All_Create_Table.sql" For Output As #fn

Dim i As Long
Do While buf <> ""
i = i + 1

Set srcBook = Workbooks.Open(Path + buf)
Set srcSheet = srcBook.Worksheets(1)  ← これを”2”にすると2シート目の名前は取得できました。でも、シート内の情報は取れませんでした。

Dim sheets_name As String
sheets_name = srcSheet.Name

Call sakuseisql_detail(fn, sheets_name)

srcBook.Close False
buf = Dir()

Loop
Close #fn
End Sub

Function sakuseisql_detail(ByRef fn, ByRef sheets_name)
On Error GoTo errorend
Dim iPk As Integer
Dim irow As Integer
Dim intkara As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim stlen As Integer
Dim bolcomma As Boolean
Dim strPK As String
Dim strcolumn As String
Dim IDENTITY As Integer
Dim strName As String
Dim strtype As String
Dim strketa As String
Dim strNN As String

'PKの列
iPk = 5

'テーブルのカラム数(項目名称の個数:2列目)
irow = Cells(Rows.Count, 2).End(xlUp).Row

bolcomma = False
strPK = ""

Print #fn, "CREATE TABLE [dbo]." & Trim(sheets_name) & " (" ←この行だけはうまく取得できるが、以下の情報が取得できません…

For i = 6 To irow
strName = Trim(Cells(i, 2).Value)
strtype = Trim(Cells(i, 3).Value)
strketa = Trim(Cells(i, 4).Value)
strPK = Trim(Cells(i, iPk).Value)
strNN = Trim(Cells(i, 6).Value)

'項目名'
Print #fn, strName;

'型とサイズ'
Print #fn, " " & strtype & "(" & strketa & ")";

'PKの有無チェック
If strPK <> "" Then
Print #fn, " PRIMARY KEY";
End If

'NOT NULL制約有無のチェック
If (strNN = "×") Then
Print #fn, " NOT NULL";
End If

If i = irow Then
Print #fn, vbCrLf & ")"
Else
Print #fn, ","
End If
Next i

Print #fn,
Print #fn,

errorend:
End Function

どのようにしたら2シート目の情報からSQLを作成できるのでしょうか。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

checkベストアンサー

+1

前の方の同じ意見ですが、前の方の修正を行っても、まだ、Activeシートに頼るところがあります。
Path = Range("B13").Value & "\"  ←読み込むExcelファイルの場所を記載しています。
irow = Cells(Rows.Count, 2).End(xlUp).Row
上記の箇所も修正が必要です。完全に修正したものが、以下のソースです。

Option Explicit

Sub CREATE_TABLEのSQL作成()

    Dim dstSheet As Worksheet
    Set dstSheet = ThisWorkbook.Worksheets(1)

    Dim Path As String
    Path = dstSheet.Range("B13").Value & "\"    '←読み込むExcelファイルの場所を記載しています。

    '入力のExcelファイル(テーブル項目)へのパス
    Dim buf As String
    buf = Dir(Path & "*.xls")

    Dim srcBook As Workbook
    Dim srcSheet As Worksheet

    '出力先ファイル(全テーブル分のCreate Table文)へのパス
    Dim fn As Integer
    fn = FreeFile
    Dim Output As String
    Output = dstSheet.Range("B16").Value    '←出力するSQLファイルの場所を記載しています。

    'SQL文の出力先ファイル
    Open Output & "\All_Create_Table.sql" For Output As #fn

    Dim i As Long
    Do While buf <> ""
        i = i + 1

        Set srcBook = Workbooks.Open(Path + buf)
        Set srcSheet = srcBook.Worksheets(2)    '← これを”2”にすると2シート目の名前は取得できました。でも、シート内の情報は取れませんでした。

        Call sakuseisql_detail(fn, srcSheet)

        srcBook.Close False
        buf = Dir()

    Loop
    Close #fn
End Sub

Function sakuseisql_detail(ByRef fn, ByVal ws As Worksheet)
    On Error GoTo errorend
    Dim iPk As Integer
    Dim irow As Integer
    Dim intkara As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim stlen As Integer
    Dim bolcomma As Boolean
    Dim strPK As String
    Dim strcolumn As String
    Dim IDENTITY As Integer
    Dim strName As String
    Dim strtype As String
    Dim strketa As String
    Dim strNN As String
    'PKの列
    iPk = 5

    'テーブルのカラム数(項目名称の個数:2列目)
    irow = ws.Cells(Rows.Count, 2).End(xlUp).Row

    bolcomma = False
    strPK = ""

    Print #fn, "CREATE TABLE [dbo]." & Trim(ws.Name) & " ("  '←この行だけはうまく取得できるが、以下の情報が取得できません…

    For i = 6 To irow
        strName = Trim(ws.Cells(i, 2).Value)
        strtype = Trim(ws.Cells(i, 3).Value)
        strketa = Trim(ws.Cells(i, 4).Value)
        strPK = Trim(ws.Cells(i, iPk).Value)
        strNN = Trim(ws.Cells(i, 6).Value)

        '項目名'
        Print #fn, strName;

        '型とサイズ'
        Print #fn, " " & strtype & "(" & strketa & ")";

        'PKの有無チェック
        If strPK <> "" Then
            Print #fn, " PRIMARY KEY";
        End If

        'NOT NULL制約有無のチェック
        If (strNN = "×") Then
            Print #fn, " NOT NULL";
        End If

        If i = irow Then
            Print #fn, vbCrLf & ")"
        Else
            Print #fn, ","
        End If
    Next i

    Print #fn,
    Print #fn,

errorend:
End Function

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/16 14:24

    各出力項目にも、対象シートを指定するのを忘れていました。
    言われてみれば、そうだ~!という感じでした。

    おかげさまで、無事に出力できました。
    お忙しいところありがとうございました!!

    キャンセル

+1

sakuseisql_detailの中が対象とするブック・シートを特定していないからでしょう。
折角ワークシートオブジェクトを取得しているのだから、シート名を渡すのではなく、シートオブジェクトそのものを渡したほうがよいかと思います。

        Set srcBook = Workbooks.Open(Path + buf)
        Set srcSheet = srcBook.Worksheets(1)
        Call sakuseisql_detail(fn, srcSheet)
~省略~
Function sakuseisql_detail(ByRef fn, sheet as Worksheet)
~省略~
    Print #fn, "CREATE TABLE [dbo]." & Trim(sheet.Name) & " ("

    For i = 6 To irow
        strName = Trim(sheet.Cells(i, 2).Value)
        strtype = Trim(sheet.Cells(i, 3).Value)
        strketa = Trim(sheet.Cells(i, 4).Value)
        strPK = Trim(sheet.Cells(i, iPk).Value)
        strNN = Trim(sheet.Cells(i, 6).Value)


基本的にVBAではアクティブ(ブック・シート)前提の作りは破綻しやすいのでお勧めしません。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/16 13:58

    お時間いただいてありがとうございます。

    Set srcBook = Workbooks.Open(Path + buf)
    Set srcSheet = srcBook.Worksheets(2) ← 2シート目が欲しいので、”2”にしました。

    Call sakuseisql_detail(fn, srcSheet) ←シート自体を渡す。
    ~省略~
    Function sakuseisql_detail(ByRef fn, sheet as Worksheet) ←シート自体をもらう。
    ~省略~
    Print #fn, "CREATE TABLE [dbo]." & Trim(sheet.Name) & " ("

    for i = 6 To irow
    :
    と変更してみましたが、出力ファイルには、
      Print #fn, "CREATE TABLE [dbo]." & Trim(sheet.Name) & " ("
    の部分のみしか出力されず、For文以下が出力されません。

    なぜでしょうか・・・

    【出力結果】
    CREATE TABLE [dbo].TB_AAA (

    CREATE TABLE [dbo].TB_BBB (

    CREATE TABLE [dbo].TB_CCC (
         :

    キャンセル

  • 2018/10/16 14:01

    irow を求めるところにもsheetを使う必要がありました。
    irow = sheet.Cells(sheet.Rows.Count, 2).End(xlUp).Row
    他にもあるかもしれないので見直してみてください。

    キャンセル

  • 2018/10/16 14:30

    お忙しいところありがとうございました。
    ご指摘の通り、
    irowを求めるところ、各項目を取得している、Cells()を使用している所に、
    折角受け取ったシートを指定していませんでした。

    sheet.Cells(....とCellsを使用しているところすべてに受け取ったパラメータを指定したら、正しく出力されるようになりました。

    ありがとうございました。
    これからもよろしくお願いします。

    キャンセル

0

sakuseisql_detail内のCellsが読み込んでるBookではなく、このマクロが書かれているBookのセルを見にいってるのではないでしょうか。

With ActiveWorkbook.Sheets(sheets_name)
  strName = Trim(.Cells(i, 2).Value)
  strtype = Trim(.Cells(i, 3).Value)
  strketa = Trim(.Cells(i, 4).Value)
  strPK = Trim(.Cells(i, iPk).Value)
  strNN = Trim(.Cells(i, 6).Value)
End With


※動作確認はしてないです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/16 14:31

    お忙しいところありがとうございました。
    他の方のご指摘の通り、修正することで解決しました。

    今後もよろしくお願いします!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.58%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る