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

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

ただいまの
回答率

90.50%

  • VBA

    2296questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1921questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    284questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Excelマクロでテーブル項目ブックの情報から別のブックにSQL文を書き出したい

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 515

yontabaru

score 9

 前提・実現したいこと

例えば1つのExcelのブック(以下、元ファイル)の、1シートごとにテーブル項目定義が
設定されていて、
その情報を元にCreate Table のSQL文を、テンプレートのブック(以下、SQLブック)の
既存シートのシートに貼り付けたい/書き出して、別名で保存したい。

・テンプレートとなるSQLブックのシート名は、元ファイルのシート名と同様にしたい。
・元ファイル1ブックの1シートから、SQL文を書き出したいSQLブックは1ブック。
つまり、2つの元ファイルに其々5つのシートがあれば、2つのSQLブックに其々5つのシートができる。
・SQL文は、SQLブックの【B30】のセルから、1行に1項目ずつ書きたい
例)

Create Table test(           ← 【B30】
  (タブ)社員番号 VARCHAR(19)      ← 【B31】
  (タブ),名前 VARCHAR(19)      ← 【B3②】
   :
   :
);                   ← 【B50とか】

 発生している問題

①書き出したいテンプレートのブックを、まずOpenすると2つ同じものが開く
②元ブックから、SQLブックへ転記ができない、シート名も変えられない
③別名で保存ができない

<<<どのように記述すると、シート名が変更できたり、セルに値が書き込めて
それを保存することができるのでしょうか。>>>

 該当のソースコード

Sub SQL定義書作成()
    Dim dstSheet As Worksheet
    Set dstSheet = ThisWorkbook.Worksheets(1)

    '入力のExcelファイル(テーブル項目説明 )へのパス
    Dim Path As String
    Path = dstSheet.Range("B23").Value & "\"

    Dim buf As String
    buf = Dir(Path & "*.xls")

    Dim srcBook As Workbook
    Dim sqlBook As Workbook

    'SQL文の出力先テンプレートファイル
    'SQL文の出力先(SQL定義書)のテンプレートファイルへのパス

        Workbooks.Open dstSheet.Range("B26").Value & "\" & "tenplate_SQL定義.xls"


    '出力先ファイル(全テーブル分の詳細設計書:SQL定義書)へのパス
    Dim Detailed_design_doc As String
    Detailed_design_doc = dstSheet.Range("B29").Value

'    Application.ScreenUpdating = False

    Dim i As Long

    Do While buf <> ""
        i = i + 1
        'テーブル項目説明書
        Set srcBook = Workbooks.Open(Path + buf)

        Call sakuseisql_detail(sqlBook, srcBook)

'        sqlBook.Close False
'       srcBook.Close False

        buf = Dir()

    Loop

    MsgBox "処理が完了しました", Title:="SQL定義書 作成"

End Sub


Function sakuseisql_detail(ByVal sqlB As Workbook, ByVal srcB As Workbook)
'    On Error GoTo errorend
    Dim irow As Integer
    Dim i As Integer
    Dim strPK As String
    Dim strName As String
    Dim strtype As String
    Dim strketa As String
    Dim strNN As String

    Dim srcSheet As Worksheet
    Dim sqlSheet As Worksheet

    Set srcSheet = srcB.Worksheets(2) ← 【一番目のシートは、変更履歴だから、”2”】
    Set sqlSheet = sqlB.Worksheets(1)

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

    '【SQL定義書のシート名設定】
    sqlSheet.Select
    sqlSheet.Name = Trim(srcSheet.Name)  ← 【設定(変更)されない!!!】

    '【SQL定義書に書込む内容】← 【書き込まれない】
    Range("G4").Select
    ActiveCell.FormulaR1C1 = sqlSheet.Name  

    Range("G5").Select
    ActiveCell.FormulaR1C1 = sqlSheet.Name

    Range("G7:N7").Select
    ActiveCell.FormulaR1C1 = "作成"

    Range("G9").Select
    ActiveCell.FormulaR1C1 = "テーブル  " & sqlSheet.Name & "  を作成するためのCreateTable文"

    '【SQL定義書に書込むSQL文】← 【書き込まれない!!!】
    Range("B30").Select
    ActiveCell.FormulaR1C1 = "CREATE TABLE " & sqlSheet.Name & " ("


    '【SQL定義書に書込む内容】
    Range("B31").Select ← 【書き込まれない!!!】


    For i = 6 To irow
        strPK = ""
        strNN = ""

        strName = Trim(srcSheet.Cells(i, 2).Value) '項目名
        strtype = Trim(srcSheet.Cells(i, 3).Value) 'データ型
        strketa = Trim(srcSheet.Cells(i, 4).Value) 'データ長
        strPK = Trim(srcSheet.Cells(i, 5).Value) 'PrimaryKey
        strNN = Trim(srcSheet.Cells(i, 6).Value)   'NULL

        If i = 6 Then
             ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbTab & " "
        Else
             ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbTab & ","
        End If

        '項目名と型とサイズ'
        ActiveCell.FormulaR1C1 = strName & " " & strtype & "(" & strketa & ")"

        'PKの有無チェック
        If strPK <> "" Then
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & " PRIMARY KEY"
        End If

        'NOT NULL制約有無のチェック
        If (strNN = "×") Then
             If strPK = "" Then
                ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & " PRIMARY KEY" & " NOT NULL"
             End If
        End If

        If i = irow Then
             ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbCrLf & ");"
        Else
             ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbCrLf
        End If

    Next i


        sqlB.SaveAs Filename:=Detailed_design_doc & "\5X_JKY_J090_SQL定義_" & sqlSheet.Name & ".xls"

'errorend:

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

回答 2

checkベストアンサー

+1

sqlBookに何のBookもsetされてないですね。
そのため、Function sakuseisql_detail のSet sqlSheet = sqlB.Worksheets(1) でエラーが起きてますがOn Error GoTo errorendがあるため、エラーメッセージが出ずにerrorend:まで処理がスキップされてます。
記入処理も保存処理もスキップしてるので②③の問題が起きてます。

ということで次のような感じでsqlBookにsetしてください。
また、On Error GoTo errorendがあるとエラーがわからなくなるので、プログラム完成までOn Error GoTo errorendはコメントアウトしておくことをお勧めします。

    'SQL文の出力先テンプレートファイル
    'SQL文の出力先(SQL定義書)のテンプレートファイルへのパス

    set sqlBook = Workbooks.Open(dstSheet.Range("B26").Value & "\" & "tenplate_SQL定義.xls")


    '出力先ファイル(全テーブル分の詳細設計書:SQL定義書)へのパス
    Dim Detailed_design_doc As String
    Detailed_design_doc = dstSheet.Range("B29").Value

'    Application.ScreenUpdating = False

    Dim i As Long

    Do While buf <> ""
        i = i + 1
        'テーブル項目説明書
        Set srcBook = Workbooks.Open(Path + buf)

        Call sakuseisql_detail(sqlBook, srcBook)

        srcBook.Close False

        buf = Dir()

    Loop

    sqlBook.Close False  'sqlBookを閉じるのはLoopの外

    MsgBox "処理が完了しました", Title:="SQL定義書 作成"

①は再現しませんでした。
入力ファイルが複数開きっぱなしになるという意味ならsrcBook.Close Falseがコメントアウトされてるからですが・・・。
あとは、B23とB26に記入されてるパスが同じならDo While~Loopのところでテンプレートファイルも開いちゃうかな?
テンプレートのBookが複数開くのかもう一度ご確認ください。

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/10/19 11:21

    超初心者で初めてマクロを書いているので、変なこと言っていたらすみません。

    set sqlBook = Workbooks.Open dstSheet.Range("B26").Value & "\" & "tenplate_SQL定義.xls"

    と書けば、
    コンパイルエラー:構文エラー のメッセージボックスが出ます。

    set sqlBook = Workbooks.Open dstSheet.Range("B26").Value & "\tenplate_SQL定義.xls"

    と書けば、
    コンパイルエラー:構文エラー のメッセージボックスが出ます。

    set sqlBook = dstSheet.Range("B26").Value & "\tenplate_SQL定義.xls"

    と書けば、
    実行時エラー '424':オブジェクトが必要です のメッセージボックスが出ます。

    なんででしょう?なぜ、セットできないんでしょう。

    ※B23とB26に記入されてるパスが同じなのでは、テストなので…実際は別になります ^^;

    キャンセル

  • 2018/10/19 11:36

    Workbooks.Openの後の括弧を書き忘れてたので修正しました。失礼しました!

    キャンセル

  • 2018/10/19 12:15 編集

    こんなにレベルの低いことまで教えていただいて、恐縮です。
    お忙しいところ申し訳ありませんが、もう少しの間お付き合いください!

    現在は、Function sakuseisql_detailの中の、
    '【SQL定義書のシート名設定】
    sqlSheet.Select

    で、実行時エラー'1004':'Select'メソッドは失敗しました:'_Worksheet'オブジェクト
    がでます。

    これは、どうしてですか?ヘルプを見たりはして変更したりしているのですが、なぜかうまく行きません。また、なにか見落としてますか?

    sqlSheetに書き込みたいから、sqlSheetの方をSelectとかActiveとかするんだと思っているんですが・・・
    Activeにしたら、怒られました。

    キャンセル

  • 2018/10/19 13:15

    まず、今回に限りませんが、質問に書かれたソースコードは修正しないでください。
    今後、この質問を読んだ人が「何がバグの原因でどう解決したのか」理解できなくなってしまいます。同じ様な悩みを持った人のためにならなくなってしまいます。
    必要があれば、元のソースコードは残して、別途ソースコードを追記してください。

    ご質問の点ですが、そこのSelectは要らないです。
    一応Selectを残してそのエラーを解消するなら sqlB.Activate を sqlSheet.Select の前に入れましょう。
    (Excelを操作する時もまずはブックを画面に出さないとシートを選択できないですよね?)

    他にも sakuseisql_detail はどのブックのRangeをSelectしてるのか指定されてない、など怪しいところが色々みうけられます。
    お節介かもしれませんが、以前の別の質問でも同じようなことになっていたので、一度きちんと、参考書やWeb上のプログラムなどを参考にしてブック・シート・セルの指定の仕方を勉強していただくのが良いかと・・・。
    他人のプログラムを書き写しながら、自分で動作確認してみて(=写経)ください。

    キャンセル

  • 2018/10/19 18:58

    すみません。そうですよね。質問時のソースを書き換えちゃだめですよね。
    別書きで追加していかないと…初歩的なことですみません。

    無事にExcelのシートに思い通りにSQL文や、他の値も記載することができました。

    ありがとうございました。

    現在、
    書き込んだSQL定義書(sqlB)の名前を付けて保存がフルパス指定できずに困っています。
    いろんなサイトを参考にしているんですが、オブジェクトが見つかりませんエラーが取れなくて…凹んでいます。

    キャンセル

  • 2018/10/19 19:09

    がんばってください!
    出てきたエラーメッセージで検索かけてみたり、「vba saveas」で検索かけてサンプルとして書かれているコードと見比べたりすると糸口になるかもしれません。
    自力で解消できるようになるのが一番ですが、駄目なようであれば新規で質問立てて回答募ってみてください。

    キャンセル

  • 2018/10/19 19:11

    はい!了解です。
    ありがとうございました。今後ともよろしくお願いいたします…(笑

    キャンセル

0

ワークシートでSQL操作をしたいのならADO接続でデータベースオブジェクトとして操作するのがいいでしょう。
井上治さんの記事「ADOでExcelワークシートに接続」のように操作します。
始めはこのADOデータベースオブジェクトのとらえ方が難しいとは思いますが、ワークシートのルールに縛られずにSQL命令で表が操作できるので馴れると楽です。コードをよく解析してみましょう。
また、シート名の書き換えもVBAで可能です。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2018/10/19 19:13

    ありがとうございました。
    私には、卓越した別世界のレベル過ぎて実現はできませんが、
    こういう方法もあることを覚えて、いつか使えたら、と思います。
    感謝感謝です。

    キャンセル

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

  • VBA

    2296questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1921questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    284questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。