- 追加された行はこの色です。
- 削除された行はこの色です。
#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]]
