カメレオンのVBA -7ページ目
Amebaホームピグアメブロ
芸能人ブログ人気ブログ
新規登録
ログイン

カメレオンのVBA

VBAの私的メモ書き

<< 前ページ

他のExcelブックをSQLでデータ抽出する

Sub test()
'1:ADOを有効にするにはVBEの[参照設定]より[Microsoft ActiveX Date Objects 2.8 Library]にチェックﾏｰｸを入れる
'2:データベースとなるワークブックは、元のワークブックと同じフォルダに入っているものとする

　Dim myAns As String
　myAns = "xxxxx" 'xxxxx　には納品先項目にある抽出する名称　→　フォームなどで選択すると○

　Dim i As Long, k As Long 'iは書き込む行の位置　kは書き込む列の位置
　Dim buf As String

　Dim dbCon As ADODB.Connection
　Dim dbRes As ADODB.Recordset

　Const cnsProvider = "Microsoft.Jet.OLEDB.4.0"
　Const cnsExtProp = "Extended Properties"
　Const cnsExcel = "Excel 8.0"
　Const cnsDBName = "testBook.xls" 'ブック名（外部データ）

　Set dbCon = New ADODB.Connection

　With dbCon
　　 .Provider = cnsProvider
　　 .Properties(cnsExtProp) = cnsExcel
　 　 .Open ThisWorkbook.Path & "\" & cnsDBName '取得するブックのパスを取得
　End With

　 ' SQL文作成
　'strSQL = "SELECT * FROM [Sheet1$]" ' 全件抽出
　strSQL = "SELECT * FROM [Sheet1$] WHERE 納品先= '" & myAns & "'"

　 'RecordSet取得
　 Set dbRes = New ADODB.Recordset
　 dbRes.CursorLocation = adUseClient

　 'SQLを実行
　 dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText

　 ' 見出し作成
　 Cells.Clear '表記するシートのセルをクリア
　 For k = 1 To dbRes.Fields.Count
　　 Cells(1, k).Value = dbRes.Fields(k - 1).Name
　 Next k

　 ' 明細書き出し
　 i = 2
　 Do While Not dbRes.EOF
　　 For k = 1 To dbRes.Fields.Count
　　　 Cells(i, k).Value = dbRes.Fields(k - 1).Value
　 Next k
　 dbRes.MoveNext
　 i = i + 1
　 Loop

　 ' 終了処理
　 dbRes.Close: Set dbRes = Nothing
　 dbCon.Close: Set dbCon = Nothing
End Sub

FindNextを用いて検索する

・FindNextを用いるとキーワードとなる言葉が入ったセルを、
指定した範囲内で全て検索する。


例：A列に山田と書かれたセルのｱﾄﾞﾚｽを、全て出力する。

sub test()
　Dim myRange As Range
　Dim myAddress As String

　Set myRange = Range("A:A").Find("山田", LookIn:=xlValues) 'オブジェクト変数なので必ずSetを明記する

　If Not myRange Is Nothing Then 'myRangeの検索条件が見つかるならば・・・
　myAddress = myRange.Address

　　Do
　　　　Debug.Print myRange.Address 'ｱﾄﾞﾚｽを出力する
　　　　Set myRange = Range("A:A").FindNext(myRange)
　　　Loop While Not myRange Is Nothing And myRange.Address <> myAddress
　　　'myRangeの検索条件が見つかっている間　⇒　処理を続行する
　　End If
end sub

Findで指定の文字が含まれたセルを検索する

・.Find("山田",LookAt:=xlWhole)...とすると完全一致検索となる（無表記およびLookAt:=xlPartならば一部検索）

・郵便番号 を郵便局から取ってきて、
エクセル上に[郵便番号]シートみたいな感じで作成しておき、
郵便番号をキーワードにしてFindを使って検索することができる。
※※※　ユーザーフォームとの組み合わせも効果的　※※※


1：A列に山田が含まれるセルを選ぶ
　Range("A:A").Find("山田").Select




2：A列に山田が含まれるセルを探し、その行数を所得する

　Debug.Print Range("A:A").Find("山田").Row


3：1行に山田が含まれるセルを探し、その行数を所得する

　Debug.Print Range("1:1").Find("山田").Row


4：A列に山田が含まれるセルを探し、そのアドレスを所得する

　Debug.Print Range("A:A").Find("山田").Address

CurrentRegion

≪for ～ next と合わせてよく使う≫

1：アクティブ セル領域の選択（ショートカット：[shift]ｷｰ + [*]ｷｰ）

例）[A1]セルのアクティブ セル範囲を選択

Range("A1").CurrentRegion.Select



2：アクティブ セル範囲の中で行数を選択

例）[A1]セルのアクティブ セル範囲で行数を選択
Range("A1").CurrentRegion.Rows.Count







3：アクティブ セル領域の中で列数を選択
例）[A1]セルのアクティブ セル領域で列数を選択
Range("A1").CurrentRegion.Columns.Count

指定したアプリケーションをアクティブにする

AppActivate は指定したアプリケーションをアクティブにする。

例）
1：ユーザーフォームをアクティブにする

AppActivate UserForm1.Caption




2：MS-WORDをアクティブにする
AppActivate Shell("C:\Program Files\Microsoft Office\Office\WinWord.exe", 1)
 

カンマ区切りxxxxx.txtをｴｸｾﾙへ書き込む

Sub test()
　Dim x As Long, y As Long
　Dim buf As String, tmp As Variant

　With Application
　　.ScreenUpdating = False '表示を停める
　　.EnableEvents = False 'イベントプロシージャを停める
　End With
'*****準備
　ActiveSheet.Cells.Clear '入力するシートのデータを消す

'******1:カレントフォルダにあるtxtファイルを開く
　ChDrive UCase(Left(ActiveWorkbook.Path, 1)) 'カレントドライブはアクティブブックがあるドライブに指定（UCaseで大文字に変換）
　ChDir ActiveWorkbook.Path 'カレントフォルダはアクティブブックに指定

　myOpenBook = CurDir & "\xxxxx.txt" '読み込むファイルの名前＋拡張子

　Open myOpenBook For Input As #1 '読み込むファイルを開く

'******2:アクティブシートへ書き込み開始
　x = 0
　Do Until EOF(1)
　　Line Input #1, buf
　　tmp = Split(buf, ",")　’カンマ区切りのデータをsplit関数で分離する
　　x = x + 1
　　For y = 1 To UBound(tmp)
　　　Cells(x, y).Value = tmp(y)
　　Next y
　Loop
　Close #1

　With Application
　　.ScreenUpdating = False '表示機能再開
　　.EnableEvents = False 'イベントプロシージャ再開
　End With
End Sub

<< 前ページ