Excel VBA(仮) の変更点
Top / Excel VBA(仮)
- 追加された行はこの色です。
- 削除された行はこの色です。
- Excel VBA(仮) は削除されています。
- Excel VBA(仮) の差分を削除
#contents **デザインパタン [#u8652b6a] ***セルに名前をつけてRange指定 [#rdf6611a] -列の増加、行の増加などで固定したいセル番地が変更することは多々ある。 -''セルに名前をつけて指定すると列、行の増減影響を受けない。'' -Range("B3")のセルに"cellName"という名前をつける。 -セルの名前のつけ方は[[こちら:http://shower.human.waseda.ac.jp/~m-kouki/pukiwiki_public/index.php?Excel%20Tips#r2516707]]を参照。 '---------------------------------------------------------------- ' 名前をつけたセルを指定する '---------------------------------------------------------------- Sub cellName() '同じセルを指定 Sheet1.Range("B3").Value = "名前をつけたセル" Sheet1.Range("cellName").Value = "名前をつけたセル" End Sub -A列とB列の間に列を挿入した場合、Sheet1.Range("cellName")ではRange("C3")を指し、 -Sheet1.Range("B3")ではRange("B3")を指すこととなる。 ''ただVBAのコードでセル名管理ができないため、シート参照してセル名を把握しなければならないところが難点。'' ***Enum(列挙型)を使用してセル指定 [#l1aaadb2] #ref(enumMethod1.JPG) Public Enum enumOCR ID = 0 ' ID InventoryBillNo = 1 ' ID InventoryDate = 2 ' 棚札番号 PlantCode = 3 ' 棚札年月日 StorageCode = 4 ' プラント CustomerCode = 5 ' 保管場所 CustomerItemCode = 6 ' 得意先コード ItemCode = 7 ' 得意先品目コード BookStock = 8 ' 品目コード End Enum ***メッセージgetter(Enum利用) [#sbfd5701] -メッセージゲット関数にメッセージ引数(Enumで定義)を渡しメッセージを取得する --メイン処理(メッセージ関数を呼び出す) '------------------------------------------------------------- ' main '------------------------------------------------------------- Sub main() '処理を開始, 処理開始メッセージを取得 Msgbox f_getInfoMessage(infoMsg.StartPrg) End Sub --メッセージ関数 渡された引数と一致するメッセージを返す '------------------------------------------------------------- ' 情報メッセージ設定(getter) '------------------------------------------------------------- Function f_getInfoMessage(msgNo) Select Case msgNo Case Is = infoMsg.StartPrg f_getInfoMessage = "処理を開始します" Case Is = infoMsg.CancelFileSelect f_getInfoMessage = "ファイル読み込みを中止します" End Select End Function --Enum設定 '------------------------------------------------------------- ' 設定 '------------------------------------------------------------- Enum infoMsg StartPrg = 0 '処理開始メッセージ CancelFileSelect = 1 'ファイル読み込みキャンセルメッセージ End Enum **セル [#bc2c7109] ***名前の定義によって設定されたセル名取得方法 [#q107d485] -mainからセル名を取得する関数を呼び出す。 -構文:Range("B3").Name.Name '---------------------------------------------------------------- ' セルにつけた名前を取得 '---------------------------------------------------------------- Sub main() Debug.Print getCellName(Sheet1.Range("B3")) Debug.Print getCellName(Sheet2.Range("B3")) 'error Debug.Print getCellNameErr(Range("B3")) Debug.Print getCellNameErr(Range("B3")) End Sub '---------------------------------------------------------------- ' セルにつけた名前を取得 '---------------------------------------------------------------- Function getCellName(targetCell As Range) getCellName = targetCell.Name.Name End Function -Range型の引数にシートを指定するとエラーとなる。 '---------------------------------------------------------------- ' セルにつけた名前を取得エラー(シート名+Range) ' コンパイルエラー:メソッド名またはデータメンバが見つかりません '---------------------------------------------------------------- Function getCellNameErr(targetCell As Range) getCellNameErr = Sheet1.targetCell.Name.Name getCellNameErr = Worksheets(1).targetCell.Name.Name End Function ***全選択 [#j75bc875] -別ブックをOpen後、全選択。元のブックのシートに値貼り付け。 Dim strFilePassName As String Dim thisBook As Workbook Dim wbInputData As Workbook 'このブック(マクロのブック)を取得 Set thisBook = ThisWorkbook 'ファイルオープン(エクセルのみオープン可) OpenFileName = Application.GetOpenFilename("Microsoft ExcelƒuƒbƒN,*.xls") If OpenFileName <> "False" Then Set wbInputData = Workbooks.Open(strFilePassName) End If 'シート1を全選択→コピー wbInputData.Sheets(1).Cells.Copy '元ブックをアクティベイト thisBook.Activate 'RangeのPasteSpecialを利用し値貼り付け Sheet4.Range("A1").PasteSpecial Paste:=xlPasteValues ’ブックをクローズ workBook1.Close **ファイル入出力 [#y8ed961b] ***FileSystemObjectプロパティ・メソッド [#ebc644c1] -[[よくまとまっているサイト:http://officetanaka.net/excel/vba/filesystemobject/filesystemobject.htm]] ***ファイル入力 [#z820f871] -フォルダ指定 --フォルダ配下のファイルを取得する(サブフォルダのファイルは含まない) With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログタイトル名 .Title = "入力ファイル用フォルダ選択" 'フォルダを選択し開くボタンがクリックされた If .Show = True Then strFoldPass = .SelectedItems(1) 'キャンセルボタンがクリックされた Else GoTo AlrtHandler End If End With '先頭のファイル名の取得 strFileName = Dir(strFoldPass & cnsDIR, vbNormal) Set FSO = CreateObject("Scripting.FileSystemObject") 'フォルダ配下にファイルがない(エラーハンドリング) If (strFileName = "") Then GoTo AlrtHandler2 'フォルダ配下にファイルがある Else 'ファイルが見つからなくなるまでLoop Do While strFileName <> "" ReDim Preserve vAllFileName(iCntFileNo) '拡張子あり vAllFileName(iCntFileNo) = strFileName iCntFileNo = iCntFileNo + 1 '次のファイル名を取得する strFileName = Dir() Loop End If ExitHandler: Exit Function AlrtHandler: 'ログ出力 Call s_setLog(f_getInfoMessage(infoMsg.CancelFileSelect)) MsgBox f_getInfoMessage(infoMsg.CancelFileSelect) '異常終了 f_getFileName = True GoTo ExitHandler AlrtHandler2: 'ログ出力 Call s_setLog(f_getAlrtMessage(infoAlrt.NotFoundFile)) '異常終了 f_getFileName = True GoTo ExitHandler ---[[ログ出力-s_setLogについて:http://shower.human.waseda.ac.jp/~m-kouki/pukiwiki_public/index.php?Excel%20VBA%20%E8%87%AA%E4%BD%9C%E9%96%A2%E6%95%B0#lf5597fa]] ---[[メッセージゲット-f_getAlrtMessage(infoAlrt.NotFoundFile)について:http://shower.human.waseda.ac.jp/~m-kouki/pukiwiki_public/index.php?Excel%20VBA%28%E4%BB%AE%29#sbfd5701]] ***ファイル名操作 [#u5124993] -取得したファイル名から拡張子なしの純粋なファイル名のみ取得 --オブジェクト:FileSystemObject --メソッド名:GetBaseName --パスを引数に渡す --存在しないフォルダ&ファイル名でも拡張子なしのファイル名を返す --ファイル名.拡張子を引数に渡しても純粋ファイル名のみを返す Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") 'Book1を返す FSO.GetBaseName("C:\Work\Book1.xls") 'Book1を返す FSO.GetBaseName("Book1.xls") Set FSO = Nothing ***ファイル書き込み [#s9dc6ec3] -テキストファイル書込 '----------------------------------------- 'ファイル書き込み '----------------------------------------- Function f_writeFile(ByVal strFoldPass, ByVal vOutPut) Dim iFileNo As Integer Dim vLoop As Variant On Error GoTo ErrHandler 'FreeFile関数 iFileNo = FreeFile 'ファイル名判定 '既にファイルが存在している場合→既存ファイルオープン 'ファイルなしの場合→新規ファイル作成 If (strOutputFileName = "") Then 'ファイル名作成 strOutputFileName = Format(Now, "YYYYMMDD_HHNNSS_") & f_getOutPutFileName & ".txt" Open strOutputFileName For Output As #iFileNo Else Open strOutputFileName For Append As #iFileNo End If For Each vLoop In vOutPut Print #iFileNo, vLoop Next vLoop Close iFileNo '正常終了 f_writeFile = False ExitHandler: Exit Function ErrHandler: '実行時エラー intRet = systemErr(Err.Number, Err.Description, "f_writeFile") '異常終了 f_writeFile = True GoTo ExitHandler End Function **関数 [#rbb4aea8] ***Chr関数 [#qee29d1d] [[Excel VBA 自作関数]] -Chr(9):タブ -Chr(10):ラインフィード -Chr(13):キャリッジリターン ***IsNumeric(数字/文字判定)関数 [#sf02a028] -String型でも中身が数字であればTrueを返す。 -IsNumeric(判定したい数字/文字) if(IsNumeric("2.3") = true )then MsgBox "数字と判定します" End if #ref(checkNumber.PNG) ***IIf関数 [#x7710003] -評価式を評価するときTrueのとき返す値、Falseのとき返す値、両方の引数を評価する。 そのためどちらかの引数でエラーが発生する場合、IIf関数はエラーになる。 -IIf(判定式,Trueのとき返す値or式,Falseのとき返す値or式) Sub test_IIf() Dim strHairType As String strHairType = "Long" 'IIf判定式 Debug.Print IIf(strHairType = "Short", "Boyish", "Girlsh") End Sub #ref(Function_IIf.PNG) **メモ [#m0564673] ***[[VBAでピボットテーブル作成:http://pvttbl.blog23.fc2.com/blog-entry-8.html]] [#kd66f011] ***シート削除 [#e72a41ec] -グラフを含むシート削除。 -Worksheets("シートの名前").Delete はだめ -Sheets("シートの名前").Delete はOK -[[As String * length:http://www.geocities.jp/cbc_vbnet/kisuhen/statement.html]]