TeraOmegaNetwork 2.1
<2020年11月>
25262728293031
1234567
891011121314
15161718192021
22232425262728
293012345

jquery drag drop html5 ASP.NET json
SVGとVue.jsのお勉強 1
IEAuto 2018新機能の整理
IEAuto 2018 0.9.4_beta
IEAuto 2018 0.9.2_beta
IEAuto 2018 0.9.1_beta
Javascript querySelector
javascript querySelector
DELETE/INSERT 作成マクロ
IEAuto 2018 0.9.0_beta

プログラミング
・C#
・C/C++
・Objective-C
・Java
・Perl
・Visual Basic
・Visual Basic .NET
・色々な言語
・メモ
管理人の落書き
リンク
テンプレート作成支援言語
IEAuto
クラス設計
試験勉強
・応用情報技術者
・セキュリティスペシャリスト







  お勧め1「テンプレート作成支援言語(T言語)」ver 1.4.2    2012/04/15 更新
テンプレート作成支援言語について
Vectorでダウンロードする

お勧め2「ブラウザ自動操作ツール(IEAuto2013)」ver 1.0.2   2013/03/01 更新。
ブラウザ自動操作ツール(IEAuto 2009)について
Vectorでダウンロードする

お勧め3「ブラウザ自動操作ツール(IEAuto2018) 」ver 0.9.4   2018/09/07 更新。
ダウンロードする。  

旧Ver:ver 0.9.0_beta

お勧め4「データベース更新前更新後比較ツール(DBCMP) Oracle接続可」ver 1.4.0  2010/03/14 新規公開
ダウンロードする。

プログラミング - Visual Basic
DELETE/INSERT 作成マクロ

昔の資産を発掘したのでアップ。
使い方はマクロ読んで。
たぶん動く…


DELETE/INSERT 作成マクロ
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Attribute VB_Name = "MakeSql"
Option Explicit

Private Type TableInfo
    ColNm As String
    IsKey As Boolean
End Type


'SQLの生成を行います。
Public Sub SubMakeSql()

    If MsgBox("実行しますか?", vbYesNo, "確認メッセージ") = vbNo Then Exit Sub
    
    'シートチェック
On Error GoTo Exception
    Dim sheetNm As String
    sheetNm = "Sheet1"
    Worksheets(sheetNm).Activate
    sheetNm = "Sheet2"
    Worksheets(sheetNm).Activate
    GoTo Finally
Exception:
    Call Throw(1001, "SubMakeSql", "シート名:" & sheetNm & "が存在しないため実行できません。")
Finally:
    
    Dim row As Long
    Dim col As Long
    
    Dim tblNm As String
    Dim arrCol(256) As TableInfo
    Dim colCnt As Long
    
    Dim outRow As Long
    outRow = 1
    
    Worksheets("Sheet2").Activate
    Cells.Select
    Selection.WrapText = False
    Selection.ClearContents
    Worksheets("Sheet1").Activate
    
    For row = 1 To 20000
    
        If Cells(row, 1).Value = "テーブル名" Then
            tblNm = Split(Cells(row, 2).Value, "(")(0)
            
            For col = 2 To 256
                arrCol(col).ColNm = Cells(row + 3, col).Value
                arrCol(col).IsKey = (Cells(row + 3, col).Font.Underline = xlUnderlineStyleSingle)
                If Cells(row + 3, col).Value = "" Then
                    colCnt = col - 1
                    Exit For
                End If
            Next
        End If
        
        If Cells(row, 1).Value = "INS" Then
            Dim sqlInsCol As String
            Dim sqlInsVal As String
            Dim sqlDel As String
            sqlInsCol = "INSERT INTO " & tblNm & "("
            
            For col = 2 To colCnt
                If col > 2 Then
                    sqlInsCol = sqlInsCol & ", "
                End If
                
                sqlInsCol = sqlInsCol & arrCol(col).ColNm
            Next
            
            sqlInsCol = sqlInsCol & ")"
            sqlInsVal = "VALUES ("
            sqlDel = ""
            Dim isFirstAnd As Boolean
            isFirstAnd = True
            For col = 2 To colCnt
                If col > 2 Then
                    sqlInsVal = sqlInsVal & ", "
                End If
                
                sqlInsVal = sqlInsVal & "'" & Cells(row, col).Value & "'"

                If arrCol(col).IsKey Then
                    If isFirstAnd Then
                        isFirstAnd = False
                        sqlDel = "DELETE FROM " & tblNm & " WHERE "
                    Else
                        sqlDel = sqlDel & " AND "
                    End If
                    
                    If Cells(row, col).Value = "" Then
                        sqlDel = sqlDel & arrCol(col).ColNm & " IS NULL"
                    Else
                        sqlDel = sqlDel & arrCol(col).ColNm & " = " & "'" & Cells(row, col).Value & "'"
                    End If
                End If
            Next
            
            sqlInsVal = sqlInsVal & ");"
            
            If sqlDel <> "" Then
                sqlDel = sqlDel & ";"
            End If
            
            Worksheets("Sheet2").Activate
            Cells(outRow, 1).Value = sqlDel
            outRow = outRow + 1
            Cells(outRow, 1).Value = sqlInsCol
            outRow = outRow + 1
            Cells(outRow, 1).Value = sqlInsVal
            outRow = outRow + 2
            Worksheets("Sheet1").Activate
        End If
    Next
    Worksheets("Sheet2").Activate
    Range("A1").Select
    
End Sub








メニュー(アドイン)
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
Attribute VB_Name = "SubMenu"
Option Explicit

'
'参考URL:http://www.aa.alpha-net.ne.jp/pcfriend/Excel/MenuBar.htm
'

Dim mySubMenu As CommandBarControl 'マイサブメニュー

'マイサブメニューの作成
Sub MakeSubMenu()
'メニューバーにコマンドボタンを作成する
Dim myMenu As CommandBar
Dim cmdSubMenu As CommandBarControl
    'すでにサブメニューがあれば削除する
    DelSubMenu

    'メニューバーに「ゆーてぃりてぃー」サブメニューを配置する
    Set myMenu = Application.CommandBars("worksheet Menu Bar")
    Set mySubMenu = myMenu.Controls.Add(Type:=msoControlPopup)
    mySubMenu.Caption = "ゆーてぃりてぃー"

    '「ゆーてぃりてぃー」サブメニューに「SQL生成」を作成
    Set cmdSubMenu = mySubMenu.Controls.Add(Type:=msoControlButton)
    cmdSubMenu.Caption = "SQL生成"
    'サブメニューでコマンド1を選択したとき cmd1() を呼び出す
    cmdSubMenu.OnAction = "BtnMakeSql"

End Sub

'マイサブメニューを削除する
Sub DelSubMenu()
'メニューバーのサブメニューを削除する
    On Error Resume Next
    mySubMenu.Delete
End Sub

'「メニュー > ゆーてぃりてぃー > SQL生成」イベント
Private Sub BtnMakeSql()
    Call SetOffscreenStart
On Error GoTo Catch
    Call SubMakeSql
    GoTo Finally
    
Catch:
    MsgBox Err.Description, vbCritical, "エラーメッセージ"
    GoTo Finally
    
Finally:
    Call SetOffscreenStop
End Sub





ゆーてぃるモジュール
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
Attribute VB_Name = "Util"
'再計算および再描画を無効にする
Public Sub SetOffscreenStart()
    Application.Cursor = xlWait
    Application.StatusBar = "処理中..."
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
End Sub


'再計算および再描画の無効を止める
Public Sub SetOffscreenStop()
    Application.Cursor = xlDefault
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

'Errが存在する場合Trueを返却します。
Function IsException() As Boolean
    IsException = Err.Number <> 0
End Function

'現在保持されているErrを投げます。
Sub DefaultThrow()
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

'パラメータを元にErrを投げます。
Sub Throw(ByVal errNumber As Integer, ByVal errSource As String, ByVal errDescription As String)
    Err.Raise errNumber, errSource, errDescription
End Sub


・検索キーワード:  VBA, マクロ, SQL

戻る  マイリストへ追加