Cyber Design Station - EXCEL メモ

EXCEL メモ

以下は、動作保証をしないので、自己責任で確認のこと。プログラム等その他により生じたいかなる損害等その他について、責任を負いませんので、予めご了承してください。

【高速化処理】

【関数関係】

【ソフトの基礎：データの入力規制と条件書式の設定】

【高速化処理】

画面描画処理の停止等による高速化自動計算処理を停止するか否かは処理の仕方にもよる。

Public mStatusBar As String

Public Function 高速化処理()

'-------------------------------

'処理の高速化をするための処理

'-------------------------------

'ウエイトカーソル。

Application.Cursor = xlWait

' アラート(警告）を表示しないようにする

Application.DisplayAlerts = False

' 画面の再描画を止める。

Application.ScreenUpdating = False

'挿入や削除のスライド表示をオフにします。

Application.EnableAnimations = False

'イベントをオフにします。

Application.EnableEvents = False

'手動計算

Application.Calculation = xlCalculationManual

' ステータスバーの現在の状況を保持した後に表示する

With Application

mStatusBar = .StatusBar

.DisplayStatusBar = True

End With

End Function

Public Function 通常に戻す処理()

'-------------------------------

'処理の高速化を通常に戻す処理

'-------------------------------

' ステータスバーの状況を元に戻した後に非表示する

With Application

.StatusBar = mStatusBar

.DisplayStatusBar = False

End With

'自動計算

Application.Calculation = xlCalculationAutomatic

'イベントをオンにします。

application.EnableEvents = true

'挿入や削除のスライド表示をオンにします。

Application.EnableAnimations = True

' 画面の再描画をする

Application.ScreenUpdating = True

' アラート(警告）を表示

Application.DisplayAlerts = True

'標準カーソル。

Application.Cursor = xlDefault

End Function

【関数関係】

DATEDIF

DSUM

dcount

dcounta

delta

dget

exact

and

or

INDEX

ISERR

ISERROR

MATch

istext

isnumber

choose

hlookup

loopup

vlookup

----------------------------------------------------------------

WorksheetFunction.text 数値を書式設定した文字列に変換

WorksheetFunction.Transpose 配列をセルに代入

WorksheetFunction.DSum 指定された列を検索し、条件を満たすレコードの合計

WorksheetFunction.Match 範囲内のアイテムの位置

WorksheetFunction.Clean 印刷できない文字を文字列から削除

----------------------------------------------------------------

InStrRev

InStr

【各種確認用】

そのうちに、もう少し、整理整頓のための一時的なメモ

'■参照設定

'Windows Script Host Object Model

'MIcrosoft Shell Controls And Automation

'Microsoft Scripting Runtime

'■Mainファイル（起動モジュール）

'■強制制御

Option Explicit

'Option Base 1

'■Mainファイル（配列関数とコレクション処理モジュール）

'■TYPEの宣言

'配列関数用

Public Type SampleA

ID As String

Name As String

End Type

'コレクション用

Public Type SampleB

Name As Collection

End Type

'■自動起動の関数（メモ：test.xlsxにも書く）

Sub Auto_Open(Optional ByVal Arg As Variant)

If VBA.IsMissing(Arg) Then

'引数なし

Else

'引数あり

End If

End Sub

'■Auto_Open関数があるファイルを呼出す関数

Public Sub 呼出関数()

Dim sFileName As String

sFileName = "test.xlsx"

Application.Workbooks.Open FileName:=Application.ThisWorkbook.path & Chr(92) & sFileName, Password:=1, WriteResPassword:=1

Application.Run Macro:=sFileName & "!Module1.Auto_Open" _

, Arg1:="引数に設定する値"

End Sub

'■ファイルの起動

Public Sub ファイル起動()

Dim oshell As New Shell32.Shell

oshell.Open ThisWorkbook.path & Chr(92) & "test.xlsx"

'Call oshell.ShellExecute(ThisWorkbook.Path & Chr(92) & "test.xlsx",,,,)

'Call oshell.ShellExecute("notepad.exe", , , vbNormalFocus)

End Sub

'■カレントディレクトリ設定

Sub カレントディレクトリ設定1()

Dim fs As IWshRuntimeLibrary.WshShell

fs.CurrentDirectory = Application.ThisWorkbook.path & Chr(92)

End Sub

Sub カレントディレクトリ設定2()

ChDir "C:\フォルダ名"

ActiveWorkbook.SaveAs FileName:="C:\フォルダ名\Sample.xlsm", _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

'■Mainファイル（関数モジュール）

'■HTML返還処理（写真のJPEG化）

Sub エクセルシートのHTML化による画像変換処理()

'BMPからJPGへ

Dim sFileName As String

ActiveWorkbook.ActiveSheet.copy

With ActiveWorkbook.PublishObjects.add( _

SourceType:=xlSourceRange, _

FileName:=Application.ThisWorkbook.path & "\test.html", _

Sheet:="Sheet1", _

Source:="A1:D10", _

HtmlType:=xlHtmlStatic, _

DivID:="Book1.xls_130489")

.Publish

.AutoRepublish = True

End With

'HTMLによる写真部分の写真ファイルのフルパスを設定

sFileName = ""

Call 画像加工処理(sFileName)

End Sub

Sub 画像加工処理(ByVal FileName As String)

ActiveSheet.DrawingObject.Delete

Range("F3").Selection

ActiveSheet.Picture.Insert(FileName).Select

Selection.Left = ActiveCell.Offset(0).Left

Selection.Top = ActiveCell.Offset(0).Top

Selection.Height = 100

Selection.With = 100

End Sub

'■Mainファイル（ファイル情報モジュール）

'■version取得処理（情報→プロパティ→詳細プロパティ→ユーザー設定でversionを追加して、値を設定しておくこと）

Sub version()

Debug.Print Application.ThisWorkbook.CustomDocumentProperties("version")

End Sub

'■配列関数Sample1

Sub 配列関数呼び出し処理()

Dim i As Integer

Dim item() As SampleA

For i = 0 To 1

item = SampleItem(i, "D" & i) '配列化

Debug.Print item(i).ID

Debug.Print item(i).Name

Public Function SampleItem(ByVal sender As Integer, ByVal sender2 As String) As SampleA()

Dim rec(1) As SampleA

rec(0).ID = sender

rec(1).ID = sender

rec(1).Name = sender

rec(1).Name = sender2

SampleItem = rec

End Function

'■コレクション処理Sample1

Sub RUN001()

'

'関数とTYPEに設定した各階層の呼び出し方

'

Dim sData() As SampleB

Dim index As Integer

index = 2

ReDim sData(index) As SampleB

Call cC(sData(index).Name)

Debug.Print sData(index).Name(1)(0)

Dim map As Collection

Dim a1 As Collection

Dim a2 As Collection

Set map = New Collection

Set a1 = cC1

Set a2 = cC2

map.add a1, "1"

map.add a2, "2"

Debug.Print map(2)(1)(0)

End Sub

Private Function cC(ByRef ret As Collection) As Boolean

Dim C As New Collection

C.add Array(11, 21), "1"

C.add Array(12, 22), "2"

Set ret = C

End Function

Private Function cC1() As Collection

Dim C As New Collection

C.add Array(11, 21), "1"

C.add Array(12, 22), "2"

Set cC1 = C

End Function

Private Function cC2() As Collection

Dim C As New Collection

C.add Array(33, 33), "1"

C.add Array(44, 44), "2"

Set cC2 = C

End Function

'■構造の基礎

Sub Collection構造の基礎()

Dim C As New Collection

C.add Array(Array(1, 2), Array(3, 4)), "C"

Debug.Print C("C")(0)(0)

Debug.Print C("C")(0)(1)

Debug.Print C("C")(1)(0)

Debug.Print C("C")(1)(1)

End Sub

Sub ScriptingDictionary構造の基礎()

Dim s As New Scripting.Dictionary

s.add "s", Array(Array(1, 2), Array(3, 4))

Debug.Print s("s")(0)(0)

Debug.Print s("s")(0)(1)

Debug.Print s("s")(1)(0)

Debug.Print s("s")(1)(1)

End Sub

【シート・ブック・セルの保護】

Option Explicit

Public Const cSheetPassword As String = "12345"

Public Sub test保護・保護解除()

Call SheetsProtect(Application.ThisWorkbook.Name, "Sheet1")

Call SheetsUnprotect(Application.ThisWorkbook.Name, "Sheet1")

Call WorkbooksProtect(Application.ThisWorkbook.Name)

Call WorkbooksUnprotect(Application.ThisWorkbook.Name)

Call CellsAllProtect(Application.ThisWorkbook.Name, "Sheet1")

Call CellsAllUnprotect(Application.ThisWorkbook.Name, "Sheet1")

Call CellsProtect(Application.ThisWorkbook.Name, "Sheet1", 1, 1)

Call CellsUnprotect(Application.ThisWorkbook.Name, "Sheet1", 1, 1)

Call RangeProtect(Application.ThisWorkbook.Name, "Sheet1", "A1:B2")

Call RangeUnprotect(Application.ThisWorkbook.Name, "Sheet1", "A1:B2")

End Sub

'シート保護

Public Function SheetsProtect(ByVal sBookName As String, _

ByVal sSheetName As String) As Boolean

Call Application.Workbooks(sBookName).Sheets(sSheetName).Protect( _

Password:=cSheetPassword, _

UserInterfaceOnly:=True)

End Function

'シート保護解除

Public Function SheetsUnprotect(ByVal sBookName As String, _

ByVal sSheetName As String) As Boolean

Call Application.Workbooks(sBookName).Sheets(sSheetName).Unprotect( _

Password:=cSheetPassword)

End Function

'ブック保護

Public Function WorkbooksProtect(ByVal sBookName As String) As Boolean

Call Application.Workbooks(sBookName).Protect( _

Password:=cSheetPassword)

End Function

'ブック保護解除

Public Function WorkbooksUnprotect(ByVal sBookName As String) As Boolean

Call Application.Workbooks(sBookName).Unprotect( _

Password:=cSheetPassword)

End Function

'全てのセル保護

Public Function CellsAllProtect(ByVal sBookName As String, _

ByVal sSheetName As String) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Cells.Locked = True

End Function

'全てのセル保護解除

Public Function CellsAllUnprotect(ByVal sBookName As String, _

ByVal sSheetName As String) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Cells.Locked = False

End Function

'指定セルの保護【cells形式】

Public Function CellsProtect(ByVal sBookName As String, _

ByVal sSheetName As String, _

ByVal x As Long, _

ByVal y As Long _

) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Cells(1, 1).Locked = True

End Function

'指定セルの保護解除【cells形式】

Public Function CellsUnprotect(ByVal sBookName As String, _

ByVal sSheetName As String, _

ByVal x As Long, _

ByVal y As Long _

) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Cells(1, 1).Locked = False

End Function

'指定セルの保護【Range形式】

Public Function RangeProtect(ByVal sBookName As String, _

ByVal sSheetName As String, _

ByVal sRange As String) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Range(sRange).Locked = True

End Function

'指定セルの保護解除【Range形式】

Public Function RangeUnprotect(ByVal sBookName As String, _

ByVal sSheetName As String, _

ByVal sRange As String) As Boolean

Application.Workbooks(sBookName).Worksheets(sSheetName).Range(sRange).Locked = False

End Function

【ソフトの基礎：四捨五入について】

四捨五入について

【ソフトの基礎：クロス集計とグラフ】

クロス集計のグラフは、ピボットグラフとピボットテーブルで作成

【ソフトの基礎：データの入力規制と条件書式の設定】

データの入力規制の設定

Sample

セルを選択（例では予め見やすいように結合済み）

設定タブの値を次のように設定する

入力値の種類：リスト

元の値：「設定,昭和,平成,令和」を直接入力

条件書式の設定

データの入力規制を設定したセルを選択

新しい書式ルールのダイアログを表示

ルールの選択：指定の値を含むセルだけを書式設定

ルールの内容

セルの値

次の値に等しい

「設定」を直接入力

「書式（Ｆ）...」ボタンを押下してセルの書式設定ダイアログを表示する。

書式の設定

セルの書式設定ダイアログを表示

フォントタブの設定で、色を「灰色」に設定

結果

リストから「設定」を選択すると文字列の色が「灰色」となっている