【VBA】ユーティリティマクロ

Option Explicit
Option Base 1


''検索系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* 指定された範囲から、指定された値を探して、見つかったRangeオブジェクトを順番にCollectionに格納して返す。
'* （※Findの仕様が変。なんで範囲の左上端をまず検出しない？？）
'* 見つからなかった場合はNothingを返す。
'*
'*************************************************************
Public Function fFindedCells(strTarget As String, rngTarget As Range) As Collection
    Dim c As Range                      ' 検索結果
    Dim firstAddress As String          ' 最初に見つかったセルのアドレス
    With rngTarget
        Set c = .Find(What:=strTarget, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Set fFindedCells = New Collection
            Do
                fFindedCells.Add c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        Else
            Set fFindedCells = Nothing
        End If
    End With
    Set c = Nothing
End Function

'*************************************************************
'*
'* 指定された範囲から、指定された値を探して、最初に見つかったRangeオブジェクトを返す。
'* 指定された範囲にあらかじめ見つけたい値が１つしかないと分かっているときに使用する。
'* 見つからなかった場合はNothingを返す。
'*
'*************************************************************
Public Function fFindedCell(strTarget As String, rngTarget As Range) As Range
    Set fFindedCell = rngTarget.Find(What:=strTarget, LookIn:=xlValues)
End Function

'*************************************************************
'*
'* 指定されたセルの値が下方向にどこまで同じ値が入っているか調べる。
'* 同じ値を持つ最後のセルを返す。
'*
'*************************************************************
Public Function fLastRange_Vertical_SameValue_of(rng As Range, limitRowIndex As Long) As Range
    Dim delta As Long
    delta = 1
    Do Until StrComp(rng.Value, rng.Offset(delta, 0).Value, vbBinaryCompare) <> 0 Or rng.Offset(delta, 0).row > limitRowIndex
        delta = delta + 1
    Loop
    Set fLastRange_Vertical_SameValue_of = rng.Offset(delta - 1, 0)
End Function

''*************************************************************
''*
''* fLastRange_Vertical_SameValue_ofの横方向版。
''*
''*************************************************************
Public Function fLastRange_Horizonal_SameValue_of(rng As Range, limitColumnIndex As Integer) As Range
    Dim delta As Integer
    delta = 1
    Do Until StrComp(rng.Value, rng.Offset(0, delta).Value, vbBinaryCompare) <> 0 Or rng.Offset(0, delta).column > limitColumnIndex
        delta = delta + 1
    Loop
    Set fLastRange_Horizonal_SameValue_of = rng.Offset(0, delta - 1)
End Function


''行・列数系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* 指定された列の最終行インデックスを返す。
'* すべてのセルに値が入っていなければ0を返す。
'*
'*************************************************************
Public Function fLastRowIndex(sht As Worksheet, inColumnIndex As Integer) As Long
    fLastRowIndex = sht.Cells(sht.Rows.Count, inColumnIndex).End(xlUp).row
    If ((fLastRowIndex = 1) And (IsEmpty(sht.Cells(fLastRowIndex, inColumnIndex)))) Then
        fLastRowIndex = 0
    End If
End Function

'*************************************************************
'*
'* 指定された行の最終列インデックスを返す。
'* すべてのセルに値が入っていなければ0を返す。
'*
'*************************************************************
Public Function fLastColumnIndex(sht As Worksheet, inRowIndex As Long) As Integer
    fLastColumnIndex = sht.Cells(inRowIndex, sht.Columns.Count).End(xlToLeft).column
    If ((fLastColumnIndex = 1) And (IsEmpty(sht.Cells(inRowIndex, fLastColumnIndex)))) Then
        fLastColumnIndex = 0
    End If
End Function

'*************************************************************
'*
'* 指定された列中で最終行インデックスの最大のものを返す。
'* 引数１    ：ワークシート
'* 引数２    ：開始列インデックス
'* 引数３    ：終了列インデックス
'*
'*************************************************************
Public Function fMaxLastRowIndex(sht As Worksheet, startColumnIndex As Integer, endColumnIndex As Integer) As Long
    If (startColumnIndex > endColumnIndex) Then
        Err.Raise 1010, , "fMaxLastRowIndex:arg2 >= arg1 でない"
    End If
    Dim i As Integer
    Dim test As Long
    For i = startColumnIndex To endColumnIndex
        test = fLastRowIndex(sht, i)
        If (fMaxLastRowIndex < test) Then
            fMaxLastRowIndex = test
        End If
    Next i
End Function


''配列系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* １次元の配列をソート(昇順)したものを返す。
'*
'*************************************************************
Public Function fSorted_Array_1_Dimension(arrSortTarget As Variant) As Variant
    Dim nowSheet As String
    Dim length As Integer
    Dim res() As Variant
    Dim shtWork As Worksheet
    Dim i As Integer
   
    nowSheet = ActiveSheet.name
    length = UBound(arrSortTarget)
    ReDim res(length)
   
    Set shtWork = fSheetAdded("配列ソート作業用")
    With shtWork
        For i = 1 To length
            .Cells(i, 1) = arrSortTarget(i)
        Next i
        .Range(shtWork.Cells(1, 1), shtWork.Cells(length, 1)).Sort Key1:=shtWork.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        For i = 1 To length
            res(i) = .Cells(i, 1)
        Next i
    End With
    fSorted_Array_1_Dimension = res

    Worksheets(nowSheet).Activate
    Call deleteSheet(shtWork)
End Function


'*************************************************************
'*
'* 二つの配列が等しければTRUEを返す。
'* (1)長さが等しい。
'* (2)同じインデックスに入っている値が全て等しい。
'*
'*************************************************************
Public Function fEqualArrayIs(array1 As Variant, array2 As Variant) As Boolean
    fEqualArrayIs = True
    Dim len1 As Integer
    Dim len2 As Integer
    len1 = UBound(array1)
    len2 = UBound(array2)
    If Not (len1 = len2) Then
        fEqualArrayIs = False
        Exit Function
    End If
    Dim i As Integer
    For i = 1 To len1
        If Not (array1(i) = array2(i)) Then
            fEqualArrayIs = False
            Exit Function
        End If
    Next i
End Function

'*************************************************************
'*
'* Collection → Array　数値を昇順ソートして移し変える。
'*
'*************************************************************
Public Function fIntArr_Collection2Array(cllc As Collection) As Variant
    Dim i As Integer
    Dim res() As Integer
    ReDim res(cllc.Count)
    For i = 1 To cllc.Count
        res(i) = cllc.Item(i).column
    Next i
    fIntArr_Collection2Array = fSorted_Array_1_Dimension(res)
End Function

'*************************************************************
'*
'* 配列中に同じ数値があればTRUEを返す。
'*
'*************************************************************
Public Function fArrayContainsIntegerIs(test As Integer, array1 As Variant) As Boolean
    fArrayContainsIntegerIs = False
    Dim len1 As Integer
    len1 = UBound(array1)
    Dim i As Integer
    For i = 1 To len1
        If (test = array1(i)) Then
            fArrayContainsIntegerIs = True
            Exit Function
        End If
    Next i
End Function

'*************************************************************
'*
'* 配列中に同じ文字列があればTRUEを返す。
'*
'*************************************************************
Public Function fArrayContainsStringIs(test As String, array1 As Variant) As Boolean
    fArrayContainsStringIs = False
    Dim len1 As Integer
    len1 = UBound(array1)
    Dim i As Integer
    For i = 1 To len1
        If (StrComp(test, array1(i), vbBinaryCompare) = 0) Then
            fArrayContainsStringIs = True
            Exit Function
        End If
    Next i
End Function

'*************************************************************
'*
'* 開始数値から終了数値までデルタ分ずつ増える配列を返す。
'*
'* arg1 : 開始数値
'* arg2 : 終了数値
'* arg3 : 増分値
'*
'* ex) fArrMapInt(-3, 10, 2) → (-3, -1, 1, 3, 5, 7, 9)
'* ex) fArrMapInt(3, 12, 2) → (3, 5, 7, 9, 11)
'*
'*************************************************************
Public Function fArrMapInt(start As Integer, en As Integer, delta As Integer) As Variant
    If (en < start) Then
        Err.Raise 1010, , "fArrMapInt:arg2 >= arg1 でない"
    End If
    Dim res() As Variant
    ReDim res(WorksheetFunction.Floor((en - start) / delta + 1, 1))
    Dim val As Integer
    val = start
    Dim idx As Integer
    idx = 1
    Do Until idx > UBound(res)
        res(idx) = val
        val = val + delta
        idx = idx + 1
    Loop
    fArrMapInt = res
End Function

'*************************************************************
'*
'* 指定された範囲の値を順に配列につめて返す。
'*
'*************************************************************
Public Function fArrFrom(rng As Range) As Variant
    Dim res() As Variant
    Dim v As Range
    Dim i As Long
    With rng
        ReDim res(.Rows.Count * .Columns.Count)
        i = 1
        For Each v In rng
            res(i) = v.Value
            i = i + 1
        Next
    End With
    fArrFrom = res
End Function


''シート系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* 選択されているシートの枚数が引数と一致していたらTRUEを返す。
'*
'*************************************************************
Public Function fSelectedSheetCountIs(test As Integer) As Boolean
    fSelectedSheetCountIs = False
    If (ActiveWindow.SelectedSheets.Count = test) Then
        fSelectedSheetCountIs = True
    End If
End Function

'*************************************************************
'*
'* 指定されたシートを削除する。
'*
'*************************************************************
Public Sub deleteSheet(sht As Worksheet)
    Application.DisplayAlerts = False
    sht.Delete
    Set sht = Nothing
    Application.DisplayAlerts = True
End Sub

'*************************************************************
'*
'* 指定された名前を持つシートを最後尾に追加し、Worksheetオブジェクトを返す。
'*
'*************************************************************
Public Function fSheetAdded(shtName As String) As Worksheet
    Worksheets.Add After:=Worksheets(Sheets.Count), Count:=1
    Worksheets(Sheets.Count).name = shtName
    Set fSheetAdded = Worksheets(shtName)
End Function

'*************************************************************
'*
'* シートを指定されたファイルに保存する。
'*
'* arg1 : Sheets
'* arg2 : ファイル名を含んだパス
'*
'*************************************************************
Public Sub saveSheets2NewBook(shts As Sheets, path As String)
    Dim bkWork As Workbook          'シートのコピー先ブック
    Dim oldSheetsCount As Integer   'シートのコピー先ブックの初期シート枚数
    Set bkWork = Workbooks.Add
    oldSheetsCount = bkWork.Worksheets.Count
    Dim shtWork As Worksheet
    For Each shtWork In bkWork.Sheets
        If (fExistSheetName(shtWork.name, shts)) Then
            shtWork.name = shtWork.name & "_rm"
        End If
        Set shtWork = Nothing
    Next
    shts.Copy After:=bkWork.Sheets(oldSheetsCount)
    Dim i As Integer
    For i = oldSheetsCount To 1 Step -1
       Call deleteSheet(bkWork.Worksheets(i))
    Next
On Error Resume Next
    bkWork.SaveAs fileName:=path
    bkWork.Close False
    Set bkWork = Nothing
End Sub

'*************************************************************
'*
'* 文字列がすでにシート名に使われているか調べる。
'*
'* arg1 : この文字列がすでに使われているか。
'* arg2 : このSheetsの中で。
'*
'*************************************************************
Public Function fExistSheetName(test As String, shts As Sheets) As Boolean
    fExistSheetName = False
    Dim sht As Worksheet
    For Each sht In shts
        If (StrComp(test, sht.name, vbBinaryCompare) = 0) Then
            fExistSheetName = True
            Exit Function
        End If
    Next
End Function

''Range系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* 列インデックスが詰まった配列を受け取り、指定された範囲をソート（昇順）する。
'* 空白セルは最小値（-999999)として扱われ最上位にくる。
'* .Selectを使ってるので、Activeシートが対象。
'* （rngTargetにSomeSheet.Range("A1:B2")とかって指定しても、SomeSheetがActivateになっていないとエラーになる）
'* 配列の第１要素が最優先されるキー、第２要素が２番目に優先されるキー、以下同様。
'*
'*************************************************************
Public Function mySort(rngTarget As Range, arrColumnIndexes As Variant) As Boolean
    Dim i As Integer
    Dim keyRange As Range
    rngTarget.Select
    Selection.Replace What:=Empty, Replacement:="-999999"
    For i = UBound(arrColumnIndexes) To 1 Step -1
        Set keyRange = Cells(ActiveCell.row, arrColumnIndexes(i))
        Selection.Sort Key1:=keyRange, Order1:=xlAscending, Header:=xlNo, MatchCase:=True
    Next i
    Selection.Replace What:="-999999", Replacement:=Empty
    Set keyRange = Nothing
End Function

'*************************************************************
'*
'* 指定されたRangeの重複のない行インデックス配列を返す。
'*
'*************************************************************
Public Function fRowIndexesIn(rng As Range) As Variant
    Dim res() As Long
    Dim test As Variant
    Dim i As Long
    i = 1
    For Each test In rng
        If (i = 1) Then
            ReDim Preserve res(i)
            res(i) = test.row
            i = i + 1
        Else
            If Not (fArrayContainsIntegerIs(test.row, res)) Then
                ReDim Preserve res(i)
                res(i) = test.row
                i = i + 1
            End If
        End If
    Next
    fRowIndexesIn = fSorted_Array_1_Dimension(res)
End Function


''ダイアログ系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* パターンダイアログを表示し選んだColorIndex、Pattern、PatternColorIndexの配列を返す。
'*
'* return : Variant型配列。ダイアログでの選択により以下のようになる。
'*          [OK] : Integer型配列 [ColorIndex, Pattern, PatternColorIndex]
'*          [キャンセル] : False
'*
'*************************************************************
Public Function fUserSelectInterior_PatternDialog() As Variant
    Dim saveColorIndex As Integer
    Dim savePattern As Integer
    Dim savePatternColorIndex As Integer
    With ActiveCell.Interior
        saveColorIndex = .ColorIndex
        savePattern = .Pattern
        savePatternColorIndex = .PatternColorIndex
    End With
    Dim bl As Boolean
    bl = Application.Dialogs(xlDialogPatterns).Show
    If (bl) Then
        Dim res(3) As Integer
        With ActiveCell.Interior
            res(1) = .ColorIndex
            res(2) = .Pattern
            res(3) = .PatternColorIndex
        End With
        fUserSelectInterior_PatternDialog = res
    Else
        fUserSelectInterior_PatternDialog = False
        Exit Function
    End If
    With ActiveCell.Interior
        .ColorIndex = saveColorIndex
        .Pattern = savePattern
        .PatternColorIndex = savePatternColorIndex
    End With
End Function


''データベース系↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

'*************************************************************
'*
'* オープン済コネクションを返す。
'* arg1 ： プロバイダ文字列
'* arg2 ： データソース文字列
'* arg3 ： ユーザID文字列
'* arg4 ： パスワード文字列
'*
'*************************************************************
Public Function fDBConnection(strProvider As String _
                            , strDataSource As String _
                            , strUser As String _
                            , strPassword As String) As ADODB.Connection
    Dim conn As New Connection
    With conn
        .ConnectionString = "Provider=" & strProvider & ";Data Source=" & strDataSource & ";User ID=" & strUser & ";Password=" & strPassword & ";"
        .Open
        .CursorLocation = adUseClient
    End With
    Set fDBConnection = conn
    Set conn = Nothing
    Exit Function
End Function

'*************************************************************
'*
'* SQLを実行する。
'* 更新系SQLはNothingを返す。
'*
'* arg1 : オープン済みコネクション
'* arg2 : SQL文字列
'* arg3 : 更新件数を受け取る変数
'*
'*************************************************************
Public Function fExecuteSql(conn As ADODB.Connection, strSql As String, Optional ByRef chgCount As Long = 0) As ADODB.Recordset
    Dim rs As New ADODB.Recordset
    chgCount = 0
    Set rs = conn.Execute(strSql, chgCount)
    If (rs.State = adStateClosed) Then
        Set fExecuteSql = Nothing
    Else
        Set fExecuteSql = rs
    End If
    Set rs = Nothing
End Function

'*************************************************************
'*
'* テーブル名一覧配列を返す。
'* arg1 : オープン済コネクション
'* arg2 : スキーマ名
'*
'*************************************************************
Public Function fTableNames(conn As ADODB.Connection, strSchema As String)
    Dim res() As Variant
    Dim rs As ADODB.Recordset
    Set rs = conn.OpenSchema(adSchemaTables, Array(Empty, strSchema))
    rs.Sort = "TABLE_NAME ASC"  'テーブルもビューも区別せず昇順に並び替える。
    Dim i As Integer
    i = 1
    Do Until rs.EOF
        ReDim Preserve res(i)
        res(i) = rs("TABLE_NAME")
        rs.MoveNext
        i = i + 1
    Loop
    fTableNames = res
    rs.Close
    Set rs = Nothing
End Function

'*************************************************************
'*
'* 指定したテーブルについての列名配列を返す。
'*
'* arg1 : オープン済みコネクション
'* arg2 : テーブル名
'* arg3 : SchemeEnum型変数
'*        adSchemaColumns : テーブルのすべての列について。
'*        adSchemaPrimaryKeys : テーブルの主キー列について。
'*
'*************************************************************
Public Function fArrTableColumnName(conn As ADODB.Connection _
                                        , tableName As String _
                                        , se As SchemaEnum) As Variant
    Dim arrCriterias() As Variant   '制約配列
    arrCriterias = Array(Empty, Empty, tableName)
    Dim rs As ADODB.Recordset
    Set rs = conn.OpenSchema(se, arrCriterias)
    Dim res() As Variant
    Dim i As Integer
    i = 1
    Do Until rs.EOF
        ReDim Preserve res(i)
        res(i) = rs("COLUMN_NAME")
        rs.MoveNext
        i = i + 1
    Loop
    fArrTableColumnName = res
    rs.Close
    Set rs = Nothing
End Function

'*************************************************************
'*
'* レコードセットから列属性配列を返す。
'*
'* arg1 : レコードセット
'* arg2 : "COLUMN_NAME" : 列名
'*        "DEFINED_SIZE" : 桁数（文字）
'*        "NUMERIC_SCALE" : 桁数（数値）
'*        "PRECISION" : 小数点以下桁数（数値）
'*
'*************************************************************
Public Function fArrColumnAttribute(rs As ADODB.Recordset, strAttribute As String) As Variant
    Dim res() As Variant
    Dim flds As ADODB.Fields
    Dim f As ADODB.field
   
    Set flds = rs.Fields
    Dim col As Integer
    col = 1
    For Each f In flds
        ReDim Preserve res(col)
        Select Case strAttribute
            Case "COLUMN_NAME": res(col) = f.name
            Case "COLUMN_TYPE": res(col) = f.Type
            Case "DEFINED_SIZE": res(col) = f.DefinedSize
            Case "NUMERIC_SCALE": res(col) = f.NumericScale
            Case "PRECISION": res(col) = f.Precision
        End Select
        col = col + 1
    Next
    fArrColumnAttribute = res
    Set f = Nothing
    Set flds = Nothing
End Function

'*************************************************************
'*
'* レコードセットから列のデータ型(DataTypeEnum型)配列を返す。
'*
'* arg1 : レコードセット
'*
'*************************************************************
Public Function fArrColumnType(rs As ADODB.Recordset) As Variant
    Dim res() As ADODB.DataTypeEnum
    Dim flds As ADODB.Fields
    Dim f As ADODB.field
   
    Set flds = rs.Fields
    Dim col As Integer
    col = 1
    For Each f In flds
        ReDim Preserve res(col)
        res(col) = f.Type
        col = col + 1
    Next
    fArrColumnType = res
    Set f = Nothing
    Set flds = Nothing
End Function

'*************************************************************
'*
'* DataTypeEnum（意味わかんない数値）を分かりやすくした文字列を返す。
'*
'* arg1 : DataTypeEnum
'*
'*************************************************************
Public Function fTranslate_TableColumnType(test As DataTypeEnum) As String
    fTranslate_TableColumnType = ""
    Select Case test
        Case 129:  fTranslate_TableColumnType = "CHAR"      'adchar
        Case 131, 139: fTranslate_TableColumnType = "NUMBER"    'adNumeric,adVarNumeric
        Case 135: fTranslate_TableColumnType = "DATE"      'adDBTimeStamp
        Case 200:  fTranslate_TableColumnType = "VARCHAR2"  'adVarChar
        Case Else: fTranslate_TableColumnType = ""
    End Select
End Function

【VBA】楽するためのマクロ

Option Base 1

Private myInterier As Variant
Private shtHistory As Collection

Private Sub auto_open()
  Application.OnKey "{F1}", ""

  'セル移動
  Application.OnKey "^{k}", "アクティブセル↑"
  Application.OnKey "^{j}", "アクティブセル↓"
  Application.OnKey "^{l}", "アクティブセル→"
  Application.OnKey "^{h}", "アクティブセル←"
 
'  Application.OnKey "^%{UP}", "ウィンドウスクロール↑"
'  Application.OnKey "^%{DOWN}", "ウィンドウスクロール↓"
'  Application.OnKey "^%{RIGHT}", "ウィンドウスクロール→"
'  Application.OnKey "^%{LEFT}", "ウィンドウスクロール←"
  Application.OnKey "^%{k}", "ウィンドウスクロール↑"
  Application.OnKey "^%{j}", "ウィンドウスクロール↓"
  Application.OnKey "^%{l}", "ウィンドウスクロール→"
  Application.OnKey "^%{h}", "ウィンドウスクロール←"
 
  'セル属性操作
  Application.OnKey "%{UP}", "セル内文字位置↑"
  Application.OnKey "%{DOWN}", "セル内文字位置↓"
  Application.OnKey "%{RIGHT}", "セル内文字位置→"
  Application.OnKey "%{LEFT}", "セル内文字位置←"
 
  Application.OnKey "^%{x}", "フォントサイズ増加"
  Application.OnKey "^+{x}", "フォントサイズ減少"
 
  Application.OnKey "^%{s}", "縮小して全体を表示する_toggle"
  Application.OnKey "^%{w}", "折り返して全体を表示する_toggle"

'  Application.OnKey "^%{l}", "格子線"
'  Application.OnKey "^+{l}", "格子線なし"
  Application.OnKey "^%{o}", "外枠線"
  Application.OnKey "^+{o}", "外枠線なし"
  Application.OnKey "^%{\}", "範囲内の縦線を引く"
  Application.OnKey "^+{\}", "範囲内の縦線を削除"
  Application.OnKey "^%{-}", "範囲内の横線を引く"
  Application.OnKey "^+{-}", "範囲内の横線を削除"
 
  Application.OnKey "^%{p}", "セルにパターンを適用_toggle"
  Application.OnKey "^+{p}", "パターンを選択し直して適用"
 
  'レンジオブジェクト操作
  Application.OnKey "^%{c}", "列幅最適化"
  Application.OnKey "^%{m}", "マージ"
  Application.OnKey "^+{m}", "マージ解除"
  Application.OnKey "^%{r}", "行ごとにマージ"
 
  'ウィンドウ操作
  Application.OnKey "^%{f}", "赤字に_toggle"
  Application.OnKey "^%{z}", "ズームアップ"
  Application.OnKey "^+{z}", "ズームダウン"
 
  'コピペ操作
  Application.OnKey "^%{v}", "値貼付け"
  Application.OnKey "^+{v}", "書式貼付け"
 
  'シート操作
  Application.OnKey "^%{RIGHT}", "次のシートへ移動"
  Application.OnKey "^%{LEFT}", "前のシートへ移動"
'  Application.OnKey "^%{n}", "アクティブシートを新規ブックにコピー"

  '印刷
'  Application.OnKey "^%{d}", "一ページに収まるよう"

End Sub

Private Sub 選択セルのアドレスをクリップボードへ()
    Dim text As String
    Dim CB As New DataObject
'DataObjectを使用するには「Microsoft Forms 2.0 Object Library」への参照が必要。
'Visual Basic Editorのメニューから［ツール］→［参照設定］コマンドを選択し［参照設定］ダイアログボックスで
'「Microsoft Forms 2.0 Object Library」にチェックを入れて、［OK］ボタンをクリックし、参照設定を行います。
'「参照可能なライブラリ ファイル」のリストにない場合は、［参照設定］ダイアログボックスで［参照］ボタンをクリックして
'「C:\WINNT(または Windows)\system32\FM20.DLL」を選択します。
   
    text = Selection.Address(False, False)
    With CB
        .SetText text
        .PutInClipboard
    End With
End Sub


Private Sub 選択セルを下へぶつかるまでコピー()
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count).Select
    ActiveSheet.Paste
End Sub


Private Sub 次のシートへ移動()
  With ActiveSheet
    If .Next Is Nothing Then
        Worksheets(1).Activate
    Else
        .Next.Activate
    End If
  End With
End Sub

Private Sub 前のシートへ移動()
  With ActiveSheet
    If .Previous Is Nothing Then
        Worksheets(Worksheets.Count).Activate
    Else
        .Previous.Activate
    End If
  End With
End Sub


Private Sub 列幅最適化()
  Selection.Columns.EntireColumn.AutoFit
End Sub

Private Sub ウィンドウ枠の固定_toggle()
  With ActiveWindow
    .FreezePanes = Not .FreezePanes
  End With
End Sub

Private Sub フォントサイズ増加()
  With Selection.Font
    .Size = .Size + 1
  End With
End Sub

Private Sub フォントサイズ減少()
  With Selection.Font
    If Not .Size = 1 Then
      .Size = .Size - 1
    End If
  End With
End Sub


Private Sub 一ページに収まるよう()
  With ActiveSheet.PageSetup
    .FitToPagesWide = 1
    .FitToPagesTall = 1
  End With
End Sub


Private Sub 行を挿入して上の行をコピー()
  Selection.EntireRow.Insert Shift:=xlDown
  Rows(ActiveCell.row & ":" & ActiveCell.row).Select
  Selection.FillDown
End Sub

Private Sub ズームアップ()
  ActiveWindow.Zoom = ActiveWindow.Zoom + 5
End Sub

Private Sub ズームダウン()
  ActiveWindow.Zoom = ActiveWindow.Zoom - 5
End Sub

Private Sub 自動連番()
  With ActiveCell
    If (.Offset(1, 0).Value = "") Then
      .Formula = "=" & .End(xlUp).Address(False, False) & "+1"
    Else
      .Formula = "=" & .Offset(-1, 0).Address(False, False) & "+1"
    End If
  End With
End Sub

Private Sub 編集後のセル移動()
  With Application
    Select Case .MoveAfterReturnDirection
      Case xlToRight:   ' ↓移動にする
        .MoveAfterReturn = True
        .MoveAfterReturnDirection = xlDown
      Case xlDown:      ' 移動なしにする
        .MoveAfterReturn = False
        .MoveAfterReturnDirection = xlUp  ' dummy else節に入るようにする。
      Case Else:        ' →移動にする
        .MoveAfterReturn = True
        .MoveAfterReturnDirection = xlToRight
    End Select
  End With
End Sub

Private Sub ウィンドウスクロール←()
  If Not (ActiveCell.column = 1) Then
    ActiveWindow.SmallScroll ToRight:=-1
    ActiveCell.Offset(0, -1).Activate
  End If
End Sub

Private Sub ウィンドウスクロール→()
  ActiveWindow.SmallScroll ToRight:=1
  ActiveCell.Offset(0, 1).Activate
End Sub

Private Sub ウィンドウスクロール↑()
  If Not (ActiveCell.row = 1) Then
    ActiveWindow.SmallScroll Up:=1
    ActiveCell.Offset(-1, 0).Activate
  End If
End Sub

Private Sub ウィンドウスクロール↓()
  ActiveWindow.SmallScroll Up:=-1
  ActiveCell.Offset(1, 0).Activate
End Sub

Private Sub アクティブセル←()
  If Not (ActiveCell.column = 1) Then
    ActiveCell.Offset(0, -1).Activate
  End If
End Sub

Private Sub アクティブセル→()
  ActiveCell.Offset(0, 1).Activate
End Sub

Private Sub アクティブセル↑()
  If Not (ActiveCell.row = 1) Then
    ActiveCell.Offset(-1, 0).Activate
  End If
End Sub

Private Sub アクティブセル↓()
  ActiveCell.Offset(1, 0).Activate
End Sub

Private Sub 選択されているセルを含む行を削除する()
  Selection.EntireRow.Delete
End Sub

Private Sub 選択されているセルを含む行で挿入()
  Selection.EntireRow.Insert Shift:=xlDown
End Sub

Private Sub 赤字に_toggle()
  With Selection
    If Not (.Font.ColorIndex = 3) Then
      .Font.ColorIndex = 3
    Else
      .Font.ColorIndex = 0
    End If
  End With
End Sub

Private Sub セルにパターンを適用_toggle()
  On Error Resume Next
  If Not IsArray(myInterier) Then
    myInterier = fUserSelectInterior_PatternDialog
  End If
  With Selection.Interior
    If (.ColorIndex = myInterier(1)) Then
      .ColorIndex = xlNone
    Else
      .ColorIndex = myInterier(1)
      .Pattern = myInterier(2)
      .PatternColorIndex = myInterier(3)
    End If
  End With
End Sub

Private Sub パターンを選択し直して適用()
  On Error Resume Next
  tmp = fUserSelectInterior_PatternDialog
  If IsArray(tmp) Then
    myInterier = tmp
  Else
    Exit Sub
  End If
  Call セルにパターンを適用_toggle
  Set tmp = Nothing
End Sub

Private Sub セル内文字位置↑()
  With Selection
    Select Case .VerticalAlignment
      Case xlTop: .VerticalAlignment = xlBottom
      Case xlCenter: .VerticalAlignment = xlTop
      Case xlBottom: .VerticalAlignment = xlCenter
      Case Else: .VerticalAlignment = xlTop
    End Select
  End With
End Sub

Private Sub セル内文字位置↓()
  With Selection
    Select Case .VerticalAlignment
      Case xlTop: .VerticalAlignment = xlCenter
      Case xlCenter: .VerticalAlignment = xlBottom
      Case xlBottom: .VerticalAlignment = xlTop
      Case Else: .VerticalAlignment = xlBottom
    End Select
  End With
End Sub

Private Sub セル内文字位置→()
  With Selection
    Select Case .HorizontalAlignment
      Case xlLeft: .HorizontalAlignment = xlCenter
      Case xlCenter: .HorizontalAlignment = xlRight
      Case xlRight: .HorizontalAlignment = xlLeft
      Case Else: .HorizontalAlignment = xlRight
    End Select
  End With
End Sub

Private Sub セル内文字位置←()
  With Selection
    Select Case .HorizontalAlignment
      Case xlLeft: .HorizontalAlignment = xlRight
      Case xlCenter: .HorizontalAlignment = xlLeft
      Case xlRight: .HorizontalAlignment = xlCenter
      Case Else: .HorizontalAlignment = xlLeft
    End Select
  End With
End Sub

Private Sub 外枠線()
  With Selection
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
  End With
End Sub

Private Sub 外枠線なし()
  With Selection
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
  End With
End Sub

Private Sub 範囲内の縦線を引く()
  With Selection
    If (.Columns.Count <= 1) Then
      Exit Sub
    End If
    .Borders(xlInsideVertical).LineStyle = xlContinuous
  End With
End Sub

Private Sub 範囲内の縦線を削除()
  With Selection
    If (.Columns.Count <= 1) Then
      Exit Sub
    End If
    .Borders(xlInsideVertical).LineStyle = xlNone
  End With
End Sub

Private Sub 範囲内の横線を引く()
  With Selection
    If (.Rows.Count <= 1) Then
      Exit Sub
    End If
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
  End With
End Sub

Private Sub 範囲内の横線を削除()
  With Selection
    If (.Rows.Count <= 1) Then
      Exit Sub
    End If
    .Borders(xlInsideHorizontal).LineStyle = xlNone
  End With
End Sub

Private Sub 格子線()
  With Selection
    .Borders.LineStyle = True
    If (.Rows.Count <= 1) Then
      Exit Sub
    End If
    If (.Columns.Count > 1) Then
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
  End With
End Sub

Private Sub 格子線なし()
  Selection.Borders.LineStyle = xlNone
End Sub

Private Sub マージ()
    Selection.MergeCells = True
End Sub

Private Sub マージ解除()
    Selection.MergeCells = False
End Sub

Private Sub 行ごとにマージ()
Application.ScreenUpdating = False
  With Selection
    startrow = .Cells(1).row
    startCol = .Cells(1).column
    endrow = .Cells(.Count).row
    endCol = .Cells(.Count).column
 
    For i = startrow To endrow
      Range(Cells(i, startCol), Cells(i, endCol)).MergeCells = True
      Application.StatusBar = i & "/" & endrow
    Next
  End With
  Application.StatusBar = False
  Application.ScreenUpdating = True
End Sub

Private Sub 縮小して全体を表示する_toggle()
  With Selection
    .WrapText = False
    .ShrinkToFit = Not .ShrinkToFit
  End With
End Sub

Private Sub 折り返して全体を表示する_toggle()
  With Selection
    .WrapText = Not .WrapText
    .ShrinkToFit = False
  End With
End Sub

Private Sub 値貼付け()
  ActiveCell.PasteSpecial Paste:=xlPasteValues
End Sub

Private Sub 書式貼付け()
  ActiveCell.PasteSpecial Paste:=xlPasteFormats
End Sub

Private Sub 改ページ挿入()
    ActiveCell.Rows.Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End Sub

Private Sub すべてのシートを選択()
  Sheets.Select
End Sub

Private Sub アクティブシートを新規ブックにコピー()
  With ActiveSheet
    .Copy
  End With
End Sub


Private Sub シート履歴に保存()
  If (shtHistory Is Nothing) Then
    Set shtHistory = New Collection
  End If
  If (shtHistory.Count = 0) Then
    shtHistory.Add Item:=ActiveSheet.Name
  Else
    shtHistory.Add Item:=ActiveSheet.Name, Before:=1
  End If
End Sub

Private Sub シート履歴()
  If (shtHistory Is Nothing) Then
    Set shtHistory = New Collection
  End If
  If (shtHistory.Count = 0) Then
    Exit Sub
  End If
 
  Dim arrShtName As Variant
  arrShtName = fArr_Collection2Array(shtHistory)
End Sub

Oracle10gインストール(Redhat4.0AS)

Oracle10gをRedhat4へインストールする際の環境構築メモ。

・Oracle10gR2

・Redhat4AS（VMware Server上のVM）

■ハード要件

  OUIインストール時に物理メモリの1.5倍を要求される。

  なので、OSインストール（VM作成）時にswap領域を確保しておく。

■必須ソフトウェア

  binutils-2.15.92.0.2-13.EL4

  compat-db-4.1.25-9

  compat-libstdc++-296-2.96-132.7.2

  control-center-2.8.0-12

  gcc-3.4.3-22.1.EL4

  gcc-c++-3.4.3-22.1.EL44

  glibc-2.3.4-2.9

  glibc-common-2.3.4-2.9

  gnome-libs-1.4.1.2.90-44.1

  libstdc++-3.4.3-22.1

  libstdc++-devel-3.4.3-22.1

  make-3.80-5

  pdksh-5.2.14-30

  sysstat-5.0.5-1

  xscreensaver-4.18-5.rhel4.2

  setarch-1.6-1

  

  【確認スクリプト】

  rpm -qa | grep binutils

  rpm -qa | grep compat-db

  rpm -qa | grep compat-libstdc++

  rpm -qa | grep control-center

  rpm -qa | grep gcc

  rpm -qa | grep gcc-c++

  rpm -qa | grep glibc

  rpm -qa | grep glibc-common

  rpm -qa | grep gnome-libs

  rpm -qa | grep libstdc++

  rpm -qa | grep make

  rpm -qa | grep pdksh

  rpm -qa | grep sysstat

  rpm -qa | grep xscreensaver

  rpm -qa | grep setarch

  

  インストールされていない場合は以下のようにインストール。

  # rpm -ivh ./glibc-kernheaders-2.4-9.1.103.EL.i386.rpm

  rpmはOSインストールCDから持ってくる。

■ユーザ、グループの作成

  # groupadd oinstall

  # groupadd dba

  # groupadd oper

  # useradd -g oinstall -G dba,oper oracle

  # passwd oracle

  Changing password for user oracle.

  New UNIX password:oracle

  BAD PASSWORD: it is based on a dictionary word

  Retype new UNIX password:oracle

  passwd: all authentication tokens updated successfully.

  #

■インストールディレクトリの作成

  # mkdir -p /u01/app/oracle

  # chown -R oracle:oinstall /u01/app/oracle

  # chmod -R 775 /u01/app/oracle

  #

■カーネル・パラメータの構成

  　変更前

  # sysctl -a | grep sem

  kernel.sem = 250        32000   32      128

  # sysctl -a | grep shm

  vm.hugetlb_shm_group = 0

  kernel.shmmni = 4096

  kernel.shmall = 2097152

  kernel.shmmax = 33554432

  # sysctl -a | grep file-max

  fs.file-max = 102421

  # sysctl -a | grep ip_local_port_

  net.ipv4.ip_local_port_range = 32768    61000

  # sysctl -a | grep ip_local_port_range

  net.ipv4.ip_local_port_range = 32768    61000

  # sysctl -a | grep rmem

  net.ipv4.tcp_rmem = 4096        87380   174760

  net.core.rmem_default = 110592

  net.core.rmem_max = 131071

  # sysctl -a | grep wmem

  net.ipv4.tcp_wmem = 4096        16384   131072

  net.core.wmem_default = 110592

  net.core.wmem_max = 131071

  vm.nfs-writeback-lowmem-only = 0

  #

  変更要は、

  

  semopen  32  -> 100

  shmmax      33,554,432  ->

           1,034,536,000/2 = 517268000

  net.ipv4.ip_local_port_range = 32768    61000

  ->

  net.ipv4.ip_local_port_range = 1024    65000

  net.core.rmem_default = 1048576 -> 262144

  net.core.rmem_max = 1048576 -> 262144

  net.core.wmem_default = 262144 -> 262144

  net.core.wmem_max = 262144 -> 262144

  

  ★以上の最終結論。★★★★★★★★★★★

  /etc/sysctl.confを編集

  以下を追記。

  kernel.sem = 250        32000   100      128

  kernel.shmmax = 536870912

  net.ipv4.ip_local_port_range = 1024    65000

  net.core.rmem_default = 262144

  net.core.rmem_max = 262144

  net.core.wmem_default = 262144

  net.core.wmem_max = 262144

  

  

  設定の反映

  # sysctl -p

  #

  ★★★★★★★★★★★★★★★★★★★★

■環境変数の設定

  oracleユーザとなり、umaskを設定する。

  # su - oracle

  $ vi .bash_profile

  umask 022

  を追記して、

  $ . .bash_profile

  $ exit

■/etc/hostsの設定

  /etc/hostsと/etc/sysconfig/networkは書いておいた方がよさげ。

  

  /etc/hosts

  192.168.1.101 rhel2

  

  /etc/sysconfig/network

  HOSTNAME=rhel2

  

  

  再起動

  # /etc/init.d/network restart

■limits.confの編集

  バックアップ

  # cp -p /etc/security/limits.conf /etc/security/limits.conf_orig

  次の行を/etc/security/limits.conf ファイルに追加します。

  oracle soft nproc 2047

  oracle hard nproc 16384

  oracle soft nofile 1024

  oracle hard nofile 65536

■pamの設定

  次の行が/etc/pam.d/login ファイルに存在しない場合は追加します。

  session required /lib/security/pam_limits.so

■インストーラの配置

  ダウンロードしてきたzipファイルを /tmp なりに置き、unzipで解凍。

  同一ディレクトリに「database」という名前のディレクトリが作成される。

  

  # cd /tmp

  # unzip 10201_database_linux32.zip

■環境変数設定

  oracleユーザの.bash_profileの編集

  

  umask 022

  

  ORACLE_BASE=/u01/app/oracle

  ORACLE_HOME=$ORACLE_BASE/product/10.1.0/db_1

  ORACLE_SID=orcl

  

  #PATH=$PATH:/bin:/usr/bin:/usr/local/bin:/usr/X11R6/bin

  LD_LIBRARY_PATH=/usr/lib:/usr/X11R6/lib

  LD_LIBRARY_PATH=$ORACLE_HOME/jdk/fre/lib/i386:$ORACLE_HOME/jdk/jre/lib/i386/server:$ORACLE_HOME/rdbms/lib:$ORACLE_HOME/lib:$LD_LIBRARY_PATH

  

  PATH=$ORACLE_HOME/bin:$PATH

  

  export PATH LD_LIBRARY_PATH

  export ORACLE_BASE ORACLE_HOME ORACLE_SID

■インストール

  # xhost +

  rootで実行すること！！

  

  

  $ DISPLAY=:0.0 ; export DISPLAY

  $ cd /tmp

  $ ./database/runInstaller

うーん、emacsよりviですな。

emacs、、、重い。。。動作も不安定だし。。。
背景色を変えるのにも四苦八苦してしまいました。
（方法が何通りもあるようですが、正式なやり方ってあるんでしょうか？）

xyzzyでemacs系のエディタには慣れているつもりですが、
はっきり言って、初期学習コストが高すぎです。
めんどくせーよ、なんだよ、インラインで日本語が使える、使えない、って、、、気にしたくねーよそんなの、、、
導入してみたはいいが、早くも気持ちよく放棄。


なんかLet Over Lambdaの著者が書いている
・emacsは編集作業そのものに視点が行ってしまう。
・編集を効率よく行うために、どう設定すればよいか、みたいなのはエディタとして気にするべき？違うよね？
・みんな効率よく編集するために、emacs設定ファイル触ってるけど、そこ本質じゃないよね？
・編集はエディタであれば設定なしでもスッと出来て当然だよね。と。

その点、viは
・編集作業は無意識に出来るのがよい。
・エディタの役割である編集自体がナチュラルに出来る。


これらの内容を思い出してしまって、（上記の本の内容はもっと過激ですがｗ）
「emacsめんどくせ～～」と思っちゃいました。

というわけでvimmerになります。

emacs導入

• Clojureに興味があり勉強したいが、開発環境がない。
• eclipseは仕事以外で立ち上げたくない。
• slimeにも興味がある。xyzzy使いだが、slimeはxyzzyからは使えなさげ。
• vimも好きでキーバインドは大好きなのだが、emacsの柔軟性に負けて、またxyzzyに戻ってきてる。kaoriya-vimよりxyzzyのほうが圧倒的に軽く、高性能。

というわけで、emacs24をWindows7に入れてみた。
emacsは全く使ったことがないので勉強がてらに選択しました。
ずっと使えるエディタになればいいなぁ。(xyzzy優秀すぎ）

１．ダウンロード
http://www.vector.co.jp/soft/dl/winnt/writing/se494046.html

　から、emacs-23.4-x64-r954-133.msiをダウンロード。ベクターにあるんですね。

２．インストール

　インストールウィザードに沿ってインストール。

　インストール先は空白含みパスを避けました。

３．.emacsファイルの配置場所の定義

　emacsは設定ファイルを自分好みに書き換えるのが醍醐味なのだが、

　その設定ファイルをどこに置けばよいか？？

　環境変数HOMEに配置場所を定義しておけばOK。

　マイコンピュータから環境変数を設定。HOME=D:\AppData　とした。

　そしてD:\AppDataに.emacs.dフォルダを作成し、emacsを起動すると、

　設定ファイルinit.elが勝手に作成されていた。

４．設定ファイルinit.elをいじる。
色んなサイトを参考に以下のように記述した。
かなり雑多に記載してますが気にしない。


(global-set-key "\C-z" 'undo)     ;;UNDO
(setq frame-title-format (format "emacs@%s : %%f" (system-name)))  ;;タイトル指定
(display-time)                    ;;時計を表示
(setq make-backup-files nil)      ;;バックアップファイルを作成しない
(setq visible-bell t)             ;;警告音を消す
(setq kill-whole-line t)          ;;カーソルが行頭にある場合も行全体を削除
(when (boundp 'show-trailing-whitespace) (setq-default show-trailing-whitespace t))  ;;行末のスペースを強調表示
(show-paren-mode)                 ;;対応する括弧を光らせる。
(column-number-mode t)            ;;カーソルの位置が何文字目かを表示する
(global-hl-line-mode)             ;;現在行を目立たせる
;(server-start)                   ;;emacsclientで接続できるようにする。
(setq inhibit-startup-screen t)   ;;スタートアップ非表示
(setq initial-scratch-message "") ;;scratchの初期メッセージ消去

;; 行番号表示
(global-linum-mode t)
(set-face-attribute 'linum nil
                    :foreground "#800"
                    :height 0.9)
;; 行番号フォーマット
;;(setq linum-format "%4d")

(setq-default line-spacing 0)     ;;行間を0にする。



気になるのは、矩形選択、検索／置換、クリップボードの扱いだ。
明日、どうなっているか調べてまたカスタマイズしよう。

ラベル別に分類した記事一覧を表示

ブログ比較サイトでのGoogle Bloggerの紹介記事では、大体、「記事一覧を表示する機能がない」とされています。
私もそれを信じていたのですが、やはり表示したい。
ということで、Google先生に聞いて調べると、JavaScriptを作成して実現する方法が出てきます。
それでも簡単で良いのですが、ほんまに無いんかいな、と管理画面を眺めていたらアッサリ発見しました。

管理画面の「レイアウト」→「ガジェットを追加」で、「ラベル」を選択するだけ。

「記事一覧を表示する機能がない」というのは、どうも私の勘違いっぽい。。。

Coders at Work

Coders at Workを読んだ。

IT業界の著名人へのインタビュー本なんですが、人の考え方とか振り返り（伝記）モノはやっぱり面白いですよね。

種類は違いますが戦うプログラマやハッカーと画家と同じように、IT業界の方（特にプログラマ）はよい刺激を受けると思う。

・プログラムに高度な数学は必要ない

・仕事で大事なのは文章力

・プログラムを作るときはまず設計する（すぐプログラムを書き始めない）

って言ってる人が多かったがこれは共感。

プログラミングに数学がいるか、というテーマでの私の意見は、

プログラミングは作文するのと同じで、文系理系で言うところの理系の能力はほとんど必要ない、

なので。

・C++は好きでない

ていう人も多かったですな。

・emacs使い

も多い。そうなんだ。。。別にどうでもいいんですが。私はvi派。

それにしても、こういう人達ってのは毎度のことながら、小さいときにラジオを分解したり（定番）、親のPC勝手に使ってプログラミングしたり、11歳のとき、父親が持ち帰ってきた粒子加速器の設計図に惹かれた、って。。。(笑）

プログラミングする方にはかなりおススメです。値段の割には分量もかなりありますし。