2010年07月28日 (水) 10時07分59秒;
EXCEL覚え書き
クリックしたセルの色を変更する
（シート内のModuleに）
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
ActiveSheet.Rows.Interior.ColorIndex = xlNone
Rows(Target.Row).Interior.ColorIndex = 15
End Sub
（指定した行のみ動作させる）
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If ActiveCell.Row < 4 Then Exit Sub
ActiveSheet.Rows("4:104").Interior.ColorIndex = xlNone
Rows(Target.Row).Interior.ColorIndex = 15
End Sub
スクロール位置を先頭に戻す
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
印刷範囲を可変設定にする
1.メニュー＞挿入＞名前＞定義＞を選択する。
2.名前定義ダイアログで、Print_Areaを選択する。
3.参照範囲に「=OFFSET($A$1,0,0,COUNTA($A:$A),100)」を入力する。
A列のデータ行の数によって、印刷範囲が可変する。
【OFFSET関数】OFFSET(基準, 行数, 列数, 高さ, 幅)
相対パスで指定する
変数 = ThisWorkbook.Path
Workbooks.Open (変数 & "\..\test.xls")
ボタンの行位置を知る
bt = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
自分自身を削除する。
Sub test()
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close (False)
End With
End Sub
フォルダ内のexcelファイルを検索する（サブフォルダも検索）
Sub test()
'フォルダを検索してxlsファイル特定する
Dim f, buf As String, cnt As Long, FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
With Application.FileSearch
.NewSearch
.Filename = "*.xls" ''ファイル名
.LookIn = "D:\data" ''フォルダ名
.SearchSubFolders = True ''サブフォルダも検索する
If .Execute() > 0 Then
For Each f In .FoundFiles
path_name = FSO.GetFile(f).ParentFolder ''パス
file_name = FSO.GetFile(f).Name ''ファイル名
MsgBox path_name & "\" & file_name
Next f
End If
End With
Set FSO = Nothing
End Sub
セルがエラーかどうか調べる
Set rg = Range("A1")
If Application.WorksheetFunction.IsError(rg) Then
'処理
End If
ユーザーフォームの表示位置を画面サイズの右側にする
Private Sub UserForm_Activate()
Me.Left = Application.Left + Application.Width - Me.Width
Me.Top = Application.Top + (Application.Height - Me.Height) / 2
End Sub
定期的にマクロを実行する
1秒ごとにA1に現在時刻を表示
'OnTime開始
Sub timer_start()
Application.OnTime Now + TimeValue("00:00:01"), "timer_start"
Range("A1") = Now()
End Sub
'OnTimeキャンセル
Sub timer_stop()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "timer_start", schedule:=False
End Sub
10秒ごとに10回先まで予約
Sub test()
For i = 1 To 10
Application.OnTime Now + TimeValue("00:00:10") * i, "my_Procedure"
Next i
End Sub
Sub my_Procedure()
MsgBox "きたー"
End Sub
ファイルダイアログでファイル名を取得する
fname = Application.GetOpenFilename( _
Title:="取り込みファイルの選択")
If fname = False Then
Exit Sub
Msgbox fname
End If
指定の表示形式を返す
Format(Now(), "yymmdd")
ファイルがあるかどうかチェックする
Sub filechk
strWrk= ここにパス記入
strFile=ここはファイル名
If Dir(strWrk & strFil) = "" Then
MsgBox("ファイルありません")
End If
End Sub
入力規則である条件では入力できないようにする
A1がバナナか、リンゴか、みかんのときで、なおかつ、B1が食べる以外のときは入力できないようにする。
データの入力規則で、
設定をユーザ定義
数式に、
=OR(AND(A1<>"バナナ",A1<>"リンゴ",A1<>"みかん"),B1="食べる")
処理中にWAITを入れる
Application.Wait [NOW()+"0:00:00.01"]
1/100秒停止
VBAでファイルコピー、移動
ファイルコピー
Option Explicit
Private Const cnsSOUR = "C:\AAA\SAMPLE1.txt" ' 元ファイル
Private Const cnsDEST = "C:\BBB\SAMPLE2.txt" ' 先ファイル
' ファイルコピーのサンプル
Sub COPY_SAMPLE()
' ファイルをコピー
FileCopy cnsSOUR, cnsDEST
End Sub
パスを含めた名前で指定する。
ファイル移動（コピーして元ファイル削除）
Option Explicit
Private Const cnsSOUR = "C:\AAA\SAMPLE1.txt" ' 元ファイル
Private Const cnsDEST = "C:\BBB\SAMPLE2.txt" ' 先ファイル
' ファイル移動のサンプル②
Sub MOVE_SAMPLE2()
' ファイルをコピー
FileCopy cnsSOUR, cnsDEST
' 元ファイルを削除
Kill cnsSOUR
End Sub
VBAでホームページを開く
ユーザーフォームのTextBox1にセットする
UserForm1.TextBox1 = "てきすと"
ユーザーフォームと変数をやり取りする
標準モジュールの先頭に、呼出し元のプロシージャとユーザフォームで共用したい変数名をPublicでセットします。
Public aaa, bbb
Sub test()
aaa = 3000
UserForm1.Show vbModeless
MsgBox bbb
End Sub
Private Sub UserForm_Initialize()
TextBox1.Text = aaa
bbb = 500
End Sub
他のブックのマクロを実行する
Application.Run "book1.xls!test"
※引数を渡す場合は、
Application.Run "'book1.xls'!test",aaa,bbb
例）
元ブック
Workbooks.Open Filename:=("sample.xls")
hiki1 = "りんご"
hiki2 = "おいしい"
Application.Run "sample.xls!ringo", hiki1, hiki2
先ブック
Sub ringo(hiki1, hiki2)
With UserForm1
.TextBox1 = hiki1
.TextBox2 = hiki2
.Show
End With
End Sub
既存のブックをコピーする
Sub bkcopy()
wp = ThisWorkbook.Path
Workbooks.Open Filename:=(wp & "\aaaa.xlsx"), ReadOnly:=True
Application.DisplayAlerts = False
Workbooks("aaaa.xlsx").Activate
ActiveWorkbook.SaveAs Filename:=wp & "\bbbb.xls"
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub
ブックを読み取り専用で開く
Workbooks.Open Filename:=("BBB.xls"), ReadOnly:=True
別のブックのセルの値を取得する（ユーザフォーム）
Private Sub UserForm_Initialize()
wp = ThisWorkbook.Path
Workbooks.Open Filename:=(wp + "\aaaa"), ReadOnly:=True
with Workbooks("aaaa.xlsx")
msg = .Sheets(1).Range("a1")
.Windows(1).Visible = True
.Close
End with
TextBox1 = msg
End Sub
アクティブなブックを閉じる
ActiveWorkbook.Close
ブックをアクティブにする
Workbooks("sample.xls).Activate
ブックを保存する
ActiveWorkbook.Save
ブックを別名で保存する
ActiveWorkbook.SaveAs "Sample.xls"
他のブックのシートのセルの値を取得（リンク方式）
Range("a1") = "='" & "c:\" & "[" & "サンプル.xls" & "]シート１'!" & Range("a1")
他のブックのシートのセルの値を取得
Workbooks.Open Filename:=("サンプル.xls"), ReadOnly:=True
Range("a1") = Workbooks("サンプル.xls").Sheets(1).Range("a1")
ActiveWorkbook.Close
開いているブックを見えなくする
Workbooks("aaaa.xlsx").Windows(1).Visible = False
指定したブックが開いているか調べる
Sub Sample15()
Dim wb As Workbook, flag As Boolean
For Each wb In Workbooks
If wb.Name = "Book1.xls" Then flag = True
Next wb
If flag = True Then
MsgBox "開いています。"
Else
MsgBox "開いていません。"
End If
End Sub
エクセルを終了する
Application.Quit
条件が一致したときのみ、コントロールを表示する
例）ComboBox1が"あり"に選択のとき、ComboBox2を表示
Private Sub ComboBox1_Change()
If ComboBox1 = "あり" Then
ComboBox2.Visible = True
Exit Sub
End If
End Sub
ユーザーフォームにコンボボックスを作成する
1.ユーザーフォームにツールボックスからコンボボックスを作成する。
2.Initialize()にコンボボックスの文字列を羅列する。
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "リスト１"
.AddItem "リスト２"
.AddItem "リスト３"
.AddItem "リスト４"
End With
End Sub
乱数を発生させるマクロ
Randomize
rnd1 = Int(Rnd * 99999999 + 1)
※99999999は0～99999999の乱数
ユーザーフォーム出現位置を設定する
Private Sub UserForm_Initialize()
Me.StartUpPosition = 0
Me.Left = 20
Me.Top = 10
End Sub
覚えておくと便利なショートカットキーのこと
その１ 現在日付を入力
〔CTRL〕+〔；〕
その２ 現在時刻を入力
〔CTRL〕+〔：〕
その３ 関数の引数を表示
〔CTRL〕+〔SHIFT〕+〔Ａ〕
たとえば、数式バーに=IFと入力してから、〔CTRL〕+〔SHIFT〕+〔Ａ〕と押すと、=IF(論理式,真の場合,偽の場合)と表示される。
その４ 書式のみのコピペ
〔CTRL〕+〔SHIFT〕+〔Ｃ〕書式のみコピー
〔CTRL〕+〔SHIFT〕+〔Ｖ〕書式のみペースト
CALL ステートメントと、引数
他のマクロを呼び出すときに、変数を受け渡す場合は、以下を参考。
Sub test()
Call メッセージ表示("あははは")
End Sub
Sub メッセージ表示(moji)
MsgBox moji
End Sub
複数受け渡す場合は、カンマで区切って列挙する。
Sub test()
Call メッセージ表示("あははは", "いひひひ", "うふふふ")
End Sub
Sub メッセージ表示(moji1, moji2, moji3)
MsgBox moji1
MsgBox moji2
MsgBox moji3
End Sub
２つのテキストファイルの比較
A.txtとB.txtを行ごとに比較します。
Sub 比較()
Dim strREC_A As String
Dim strREC_B As String
Dim File_A As String
Dim File_B As String
Dim ForderPass As String
Dim CT As Long
ForderPass = ThisWorkbook.Path
File_A = "\A.txt"
File_B = "\B.txt"
Open ForderPass & File_A For Input As #1
Open ForderPass & File_B For Input As #2
CT = 1
st:
If EOF(1) Or EOF(2) Then
GoTo owari
End If
Line Input #1, strREC_A
Line Input #2, strREC_B
If strREC_A <> strREC_B Then
MsgBox CT & "行目 違う。" & vbCrLf & strREC_A & vbCrLf & strREC_B
End If
CT = CT + 1
GoTo st
owari:
Close #1
Close #2
MsgBox "終了。"
End Sub
テキストファイルの内容をセルに読み込む マクロ
Sub READ_TextFile()
Const cnsFILENAME = "\sample.txt"
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 読み込んだレコード内容
Dim GYO As Long ' 収容するセルの行
' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(入力モード)
Open ThisWorkbook.Path & cnsFILENAME For Input As #intFF
GYO = 1
' ファイルのEOF(End of File)まで繰り返す
Do Until EOF(intFF)
' 改行までをレコードとして読み込む
Line Input #intFF, strREC
' 行を加算しA列にレコード内容を表示(先頭は2行目)
Cells(GYO, 1).Value = strREC
GYO = GYO + 1
Loop
' 指定ファイルをCLOSE
Close #intFF
End Sub
文字列をテキストファイルへ書き出す マクロ
Sub WRITE_TextFile()
Const cnsFILENAME = "\SAMPLE.txt"
Dim intFF As Integer ' FreeFile値
Dim strREC As String ' 書き出すレコード内容
' FreeFile値の取得(以降この値で入出力する)
intFF = FreeFile
' 指定ファイルをOPEN(出力モード)
Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF
' 内容をレコードにセット
strREC = "test"
' レコードを出力
Print #intFF, strREC
' 指定ファイルをCLOSE
Close #intFF
End Sub
処理実行中のカーソルを砂時計にする
Application.Cursor = xlWait
元に戻すには、
Application.Cursor = xlDefault
セルの値を簡易棒グラフで表示する
以下の様な表示。
A列にパーセンテージを入力。
B列に■で棒グラフが作成される。
B列の関数
=LEFT("■■■■■■■■■■",TRUNC($A1/0.1))
※条件書式で、100%を赤く設定してあります。
エクセルで早口言葉？
ユーザーフォームのテキストボックス内での制御プロパティ
SelLength
選択されたテキストの文字数を設定します。
値の取得も可能です。
SelStart
選択されたテキストの開始点を設定します。
値の取得も可能です。テキストが選択されていないときは、
挿入ポインタの位置を示します。
SelText
現在選択されているテキストを含む文字列を設定します。
値の取得も可能です。文字が選択されていないときは、長さ 0 の文字列 ("") を返します。
例）TextBox1.SelStart = 0
カーソル位置を先頭にします。
ユーザーフォームのテキストボックス内で改行する。
EnterKeyBehaviorをTrueに設定します。
MultiLineもTrueに設定しておく必要があります。
Format関数
Format([値],"[書式設定]")
以下は書式設定
カンマ区切り ： #,##0 ： 1,234
￥マーク入り ： \\#,##0 ： \1,234
単位付き ： #,##0\円 ： 1,234円
小数点桁数の指定 ： #,##0,0000 ： 1,234.5670
小数点桁数の指定２ ： #,##0,0### ： 1,234.567
日付の書式 ： YYYY/MM/DD HH:NN:SS ： 2002/11/28 10:18:30
YYYYMMDDをYYYY/MM/DD ： @@@@/@@/@@ ： 20021128->2002/11/28
西暦を和暦 ： GGGEE\年MM\月DD\日 ： 2002/11/28->平成14年11月28日
和暦を西暦 ： YYYY\年MM\月DD\日 ： 平成14年11月28日->2002年11月28日
数値を曜日 ： AAAA ： 1->日曜日
四半期を返す ： Q ： 2002/01->1
郵便番号 ： @@@-@@@@ ： 2510871->251-0871
左に0を充填 ： 00000 ： 123->00123
左に半角スペースを充填 ： @@@@@ ： 123-> 123
全部大文字 ： > ： abc->ABC
全部小文字 ： < ： ABC->abc
曜日：aaa：2003/01/30 -> 木
カンマ区切りで0なら表示しない : #,### : 1234->1,234 0->(表示しない)
ユーザーフォームをモードレスで表示する
UserForm1.Show vbModeless
vbModelessをつけると、ユーザーフォームを表示しながら、セルの選択などができます。
ユーザーフォームで簡易プログレスバーをつくる。
１．Visual Basic Editerを開く。Alt+11
２．メニューの挿入→ユーザーフォームを選択して、フォームを新規作成する。
３．ツールボックスの、「ラベル」で以下のようにラベルを２つと、「コマンドボタン」でボタンを一つ作成する。
４．作成したコマンドボタン上で右ボタンを押して、プロパティを表示して、Captionを「OK」に変更する。
５．ユーザーフォームを選択した状態で、F7を押して、コードを表示する。
６．表示されているコードをすべて削除して、以下のコードを入力する。
Private Sub UserForm_Activate()
Label2 = "作業中です..."
lb = "■"
For i = 0 To 100
Label1 = lb
DoEvents
lb = lb + "■"
'ここから処理
For w = 1 To 10000
For x = 1 To 100
Next x
Next w
'ここまで処理
Next i
CommandButton1.Enabled = True
Label2 = "完了しました。"
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
７．Visual Basic Editerを閉じる。
８．新規マクロに以下を入力する。
Sub プログレス()
UserForm1.Show
End Sub
９.マクロ「プログレス」を実行する。
DATEVALUE関数とTIMEVALUE関数
指定された文字列からシリアル値を求めるものです。
例）
TIMEVALUE（"6:0:0"）
DATEVALUE（"2008/2/14"）
YEAR関数
指定した日付の年を返します。
例）YEAR(Now())
実行中のマクロを強制終了する。
- Dos/V機 [CTRL]+[Break(Pause)]
- PC9800シリーズ [CTRL]+[STOP]
他のシートのセルの内容を取得する マクロ
aaa=Worksheets("Sheet1").Range("A1")
シートがアクティブになったら、指定したマクロを実行する。
Sub Auto_Open()
'Sheet1がアクティブになったら「Macro1」マクロ実行
Worksheets("Sheet1").OnSheetActivate = "Macro1"
End Sub
曜日まで表示する表示形式設定
yyyy"年"m"月"d"日（"aaa"）"
シート名一覧を取得するマクロ その２
Sub シート一覧()
ct = 1
For I = 1 To Sheets.Count
shname = Sheets(I).Name
Cells(ct, 1) = shname
ct = ct + 1
Next
End Sub
データの最終行を知る マクロ
er = Range("A" & 65536).End(xlUp).Row
フォルダのコピー マクロ
c:\001の内容を%temp%\書庫へコピーします。
Sub FolderCopy()
Dim SourcFolderSpec, DestFolderSpec, TempFolder As String
Dim SourcFolder_Object, DestFolder_Object As Object
Dim FileNamePath As Variant
'環境変数TEMP を取得します
TempFolder = Environ("temp")
'Source Folder をセットします
SourcFolderSpec = "c:\001"
'Destination Folder をセットします
DestFolderSpec = TempFolder & "\書庫"
'フォルダオブジェクトを取得
Set SourcFolder_Object = CreateObject _
("Scripting.FileSystemObject").GetFolder(SourcFolderSpec)
'SourcFolderSpec内の全ファイルをDestFolderSpecにコピー
'サブフォルダも対象になります
SourcFolder_Object.Copy DestFolderSpec
MsgBox "完了しました"
End Sub
文字列の操作
=LEFT(文字列,[文字数])
：文字列の左端から指定した文字数だけ取り出す。
文字数を省略すると1を指定したことになります(1の時は省略できる)。
=RIGHT(文字列,[文字数]）
：文字列の右端から指定した文字数だけ取り出す。
文字数を省略すると1を指定したことになります(1の時は省略できる)。
=MID (文字列，開始位置,文字数)
：文字列の指定した位置から指定した文字数だけ取り出す。
=SEARCH(検索文字列,対象,開始位置)
文字列が開始位置から何番目にあるかを返します
英字の大文字と小文字を区別できませんが、ワイルドカード文字を使用できます。
=FIND(検索文字列,対象,開始位置)
文字列が開始位置から何番目にあるかを返します
英字の大文字と小文字を区別できる代わりに、ワイルドカード文字を使用することができません。
選択したフォルダ内のファイル一覧を取得するマクロ
Sub ファイルリスト()
Dim filename As String 'ファイル名
Dim DrvDir As String 'フォルダパス
Dim rw As Long '行カウンタ
Dim ShellApp As Object 'ShellApp
Dim myFolder As Object 'フォルダ名
Set ShellApp = CreateObject("Shell.Application")
Set myFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)
If myFolder Is Nothing Then Exit Sub
DrvDir = myFolder.items.Item.Path & "\" 'フォルダパスをセットする
With Worksheets("Sheet1")
.Range("A2:A65536").ClearContents '表示用のA列をクリア
rw = 1
'フォルダを検索してファイルとフォルダを特定する
filename = Dir(DrvDir & "*.*", vbDirectory)
While filename <> ""
'順にSheet1に書き出していく
rw = rw + 1
.Range("A" & rw) = filename
filename = Dir(, vbDirectory)
Wend
End With
End Sub
ブックの共有操作のマクロ
Sub ブックの共有を解除()
'ブックの共有を解除
Application.DisplayAlerts = False
If ActiveWorkbook.MultiUserEditing Then _
ActiveWorkbook.ExclusiveAccess
End Sub
Sub ブックの共有をする()
'ブックの共有をする
Application.DisplayAlerts = False
ActiveWorkbook.KeepChangeHistory = True
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
AccessMode:=xlShared
End Sub
メッセージボックスのアイコン
vbCritical 警告メッセージ アイコン
vbQuestion 問い合わせメッセージ アイコン
vbExclamation 注意メッセージ アイコン
vbInformation 情報メッセージ アイコン
セル範囲指定で絶対的な座標で指定する
INDIRECT("A1:A100"))
このように設定すると、行が削除されてもA100は変化しない
メッセージボックスで改行する
MsgBox "これは" & vbCrLf & "ペンデス"
ステータスバーに表示するマクロ
Application.StatusBar = "リスト取得中です...(現在 " & rw - 3 & "件)"
実行中の自動計算をオフにするマクロ
Application.Calculation = xlCalculationManual
オンに戻すには以下のマクロ
Application.Calculation = xlCalculationAutomatic
実行中の画面の更新を無効にする
Application.ScreenUpdating = False
有効にするには、FalseをTrueです
指定した文字列が含まれる行以外を削除するマクロ
Sub 行削除()
Dim Rwe As Long
Dim R As Long
Dim delname As String
delname = InputBox("検索対象を入力してください", "検索")
If delname = "" Then
MsgBox "検索を中断します", vbInformation, "検索"
End
End If
Rwe = Range("B" & 65536).End(xlUp).Row
For R = Rwe To 1 Step -1 'To 1では、１行目から検索します
If Application.CountIf(Rows(R), "*" & delname & "*") = 0 Then '=0 を >0にすると、検索対象がある行を削除します
Rows(R).Delete
End If
Next
MsgBox delname & " 以外を除去しました", vbInformation, "検索"
End Sub
24時間を越える場合のマクロでの記述
Sub 24over()
RT = Int(Range("A1") * 24) & ":" & Format(Range("A1"), "nn:ss")
MsgBox "経過時間は" & RT & "です。"
End Sub
アクティブシートの名前を変更するマクロ
ActiveSheet.Name = シート名
アクティブブックのシートをコピーするマクロ
Sheets("シート名").Copy
シート４の後に追加コピー
Sheets("シート名").Copy Before:=Sheets(4)
ワークシートを別のBOOKへ保存するマクロ
あらかじめ、Bookと同じディレクトリに書庫というフォルダを作成しておいてください。
Sub 書庫へ保存()
yesno = MsgBox("シートを保存します よろしいですか？", vbYesNo + vbQuestion, "進捗度表")
If yesno = vbNo Then
End
End If
wpath = ThisWorkbook.Path & "\" 'パスを設定する
sheetname = ActiveWorkbook.ActiveSheet.Name 'シート名を取得する
datenow = Format(Now, "yyyymmdd") '日時を設定
savename = wpath & datenow & "_" & sheetname & ".xls" 'ファイル名設定
savename_msg = datenow & "_" & sheetname & ".xls" '表示用ファイル名設定
Sheets(sheetname).Copy 'シートを新規ブックへコピー
ActiveWorkbook.SaveAs Filename:=savename '新規ブックを保存する
ActiveWorkbook.Close '新規ブックを閉じる
Application.DisplayAlerts = False '警告メッセージオフ
Worksheets(sheetname).Delete
Application.DisplayAlerts = True '警告メッセージオン
MsgBox savename_msg & vbCrLf & "書庫へ保存しました", vbInformation, "シート保存"
End Sub
「はい」「いいえ」ダイアログを表示するマクロ
Sub 問い合わせ()
yesno = MsgBox("シートを保存します よろしいですか？", vbYesNo + vbQuestion, "問い合わせ")
If yesno = vbNo Then
End
End If
End Sub
複数条件のカウント SUMPRODUCT関数 その２
=SUMPRODUCT((A1:A10="初稿"*(MONTH(B1:B10)=3)*(ISNUMBER(FIND("出版",C1:C10)))))
A1:A10が初稿で、B1:B10が3月で、C1:C10の文字列に”出版”という文字を含んでいるならカウントする
（解説）
ISNUMBER(セル番地または計算式）
参照しているセルが数値かどうか調べる。
数値なら TRUE (1)
数値でないなら FALSE (0)
FIND(検索文字列,対象,開始位置)
参照しているセルの検索文字列の位置を調べる
含まれない場合は#VALUEとなる。
複数条件のカウント SUMPRODUCT関数
=SUMPRODUCT((A1:A10="初稿")*(MONTH(B1:B10)=3))
A1:A10が初稿でB1:B10が3月ならカウントする
シリアル値から日付データ「年」「月」「日」を取り出す
=YEAR(シリアル値)
=MONTH(シリアル値)
=DAY(シリアル値)
範囲内の最大値、最小値を求める
範囲内の最大値
=MAX(範囲)
範囲内の最小値
=MIN(範囲)
例）
=MAX（A1:A5)
=MIN(B1:B5)
=MAX（A1:A5)-MIN(B1:B5)
BOOKを開いたら、マクロを自動で実行する
Sub Auto_Open()
MsgBox "自動です" 'ここに必要な処理を記述します
End Sub
ラベルへジャンプするマクロ
GoTo ラベル:
ラベル:
例）
Sub goto001()
If ActiveCell.Value = True Then
GoTo msg1
End If
End
msg1:
MsgBox "Trueですよ"
End Sub
アクティブセルの位置を調べるマクロ
行位置
ActiveCell.Row
列位置
ActiveCell.Column
シートをアクティブにするマクロ
Worksheets("Sheet1").Activate
ワークブックを開くマクロ
Workbooks.Open Filename:=ThisWorkbook.Path & "ファイル名.xls"
アクティブセルの内容を取得するマクロ
bn = ActiveCell.Value
指定したセルに値を代入するマクロ
A5に1を代入
Cells(5,1).Value=1
指定範囲内のセルに値を代入するマクロ
A1 C5の範囲に1を代入
Range("a1:c5").Value=1
シート名の一覧を表示するマクロ
Sub ListSheetsName()
Dim objSheet As Object
Dim intLoop As Integer
intLoop = 1
For Each objSheet In ActiveWorkbook.Sheets
Cells(intLoop, 1).Value = objSheet.Name
intLoop = intLoop + 1
Next
End Sub
（補足）
Cells(intLoop, 1).Value = objSheet.Name
を
Cells(intLoop, 1).Value = objSheet.Range("A1")
にすると、参照シート内のA1の内容を持ってこれる。
セルにアクティブシート名を表示する
=MID(CELL("filename"),FIND("]",CELL("filename"))+1,31)
重複データを削除する
（A1セルにフィールド見出し、A2:A10セルに9個のデータが入力されているときに、重複データを削除した新たなリストをC列に作成する例）
メニュー［データ］－［フィルタ］－［フィルタオプションの設定］をクリック
↓
［フィルタオプションの設定］ダイアログで
［抽出先］欄で［指定した範囲］オプションボタンをOnに
［リスト範囲］欄で「A1:A10」セルを
［抽出範囲］欄で「C1」セルを
［重複するレコードは無視する］チェックボックスをOnに
設定
↓
［フィルタオプションの設定］ダイアログ－［OK］ボタンをクリック
条件にあったものの合計
=SUMIF(B1:B4,"りんご",C1:C4)
B1~B4のりんごに該当するもののみ、C1~C4の合計を計算
クリックした図形のセルの色を変えるマクロ
以下のマクロを、セル上の図形に登録する。
Sub iro001()
Dim button As Range
'セル位置取得 button
Set button = ActiveSheet.Shapes(Application.Caller).TopLeftCell
'セル位置 0,0の色を変更
With button.Offset(0, 0).Interior
.ColorIndex = 10
.Pattern = xlSolid
End With
End Sub
セルに時間を記録するマクロ
A2が開始なら、B2に現在時刻を返す。
A2が終了なら、C2に現在時刻を返す。
Sub jikankiroku()
If Range("A2").Value = "開始" Then
Range("B2") = Now()
End If
If Range("A2").Value = "終了" Then
Range("C2") = Now()
End If
End Sub
=COUNTIF関数
=COUNTIF(A1:A10,"合格")
A1～A10までのセルに「合格」が何個存在するか返す。
=COUNTIF(A1:A10,"合格")+COUNTIF(A1:A10,"不合格")
とすると、合格+不合格の合計数が何個あるか返す。
条件付書式
セルの内容によって、書式を変化させる。
例）セルの値が”合格”なら、セルパターン＝赤色、文字色＝白
IF関数
=IF(A1="","",IF(A1>50,"○","×"))
A1が空白なら、空白。
空白以外なら、A1>50をチェック。
50以上なら○
50以下なら×。
セルのコピー＆貼り付け
セルが別のセルを指している時に そのセルを別の位置にコピーすると、移動した分だけ指していた位置まで移動してしまう。
これを移動させず、指している位置が変わらないままにするには、変えたくない行・列には「$」を前につけて、「$A$1」といった指定をする。
セル内の文字列をリスト形式で選択
１ ［▼］を押して選択するためのリストを別の場所に作成。
２ ドロップダウンリストを表示させたいセルを選択して、メニューバー［データ］から［入力規則］をクリック。
３ ［設定］タブの［入力値の種類］で［リスト］を選択し、［元の値］に文字カーソルを移します。
４ ドロップダウンリストの元となる、欄外に入力したデータを範囲選択する。
５ ［ＯＫ］を押す。
最終更新：2010年07月28日 10:07
