ブログ一覧

関数 組み込み関数から対数を求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から対数を求める

Function LogN(x, n) As Double
'**********************************************
'組み込み関数から対数を求める
'**********************************************
LogN = Log(x) / Log(n)
End Function
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-双曲線-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-双曲線-サイン-コサイン-タンジェントを求める
'HSinHCosHTan

Function HSin(x) As Double
'**********************************************
'双曲線サイン Hyperbola-Sine を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HSin = (Exp(x) - Exp(-x)) / 2
End Function


Function HCos(x) As Double
'**********************************************
'双曲線コサイン Hyperbola-Cosine を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCos = (Exp(x) + Exp(-x)) / 2
End Function


Function HTan(x) As Double
'**********************************************
'双曲線タンジェント Hyperbola-Tangent を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HTan = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
End Function


Private Sub test1()
Debug.Print 4 * HTan(1)
End Sub


  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-双曲線-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-双曲線-セカント-コセカン-コタンジェンを求める
'HSecHCosecHCotan

Function HSec(x) As Double
'*****************************************************
'双曲線セカント Hyperbola-Secant を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HSec = 2 / (Exp(x) + Exp(-x))
End Function


Function HCosec(x) As Double
'*****************************************************
'双曲線コセカント Hyperbola-Cosecant を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCosec = 2 / (Exp(x) - Exp(-x))
End Function


Function HCotan(x) As Double
'*****************************************************
'双曲線コタンジェント Hyperbola-Cotangent を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCotan = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
End Function


Private Sub test1()
Debug.Print 4 * HCotan(1)
End Sub



  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-双曲線アーク-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-双曲線アーク-セカント-コセカン-コタンジェンを求める
'HArcsecHArccosecHArccotan

Function HArcsec(x) As Double
'**************************************************************
'双曲線アークセカント Hyperbola-Arc-Secant を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArcsec = Log((Sqr(-x * x + 1) + 1) / x)
End Function


Function HArccosec(x) As Double
'**************************************************************
'双曲線アークコセカント Hyperbola-Arc-Cosecant を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccosec = Log((Sgn(x) * Sqr(x * x + 1) + 1) / x)
End Function


Function HArccotan(x) As Double
'**************************************************************
'双曲線アークコタンジェント Hyperbola-Arc-Cotangent を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccotan = Log((x + 1) / (x - 1)) / 2
End Function




  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-セカント-コセカント-コタンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'組み込み関数から三角関数-セカント-コセカント-コタンジェントを求める
'SecCosecCotan
Function Sec(x) As Double
'*********************************
'セカント Secant を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Sec = 1 / Cos(x)
End Function


Function Cosec(x) As Double
'*********************************
'コセカント Cosecant を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Cosec = 1 / Sin(x)
End Function


Function Cotan(x) As Double
'*********************************
'コタンジェント Cotangent を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Cotan = 1 / Tan(x)
End Function
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-双曲線アーク-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-双曲線アーク-サイン-コサイン-タンジェントを求める
'HArcsinHArccosHArctan

Function HArcsin(x) As Double
'********************************************************
'双曲線アークサイン Hyperbola-Arc-Sine を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArcsin = Log(x + Sqr(x * x + 1))
End Function


Function HArccos(x) As Double
'********************************************************
'双曲線アークコサイン Hyperbola-Arc-Cosine を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccos = Log(x + Sqr(x * x - 1))
End Function


Function HArctan(x) As Double
'********************************************************
'双曲線アークタンジェント Hyperbola-Arc-Tangent を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArctan = Log((1 + x) / (1 - x)) / 2
End Function
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 数値表示書式指定文字の使用例Format関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'(VB:Help)
'
'指定した書式 (format)  正の数 5     負の数 5        小数 .5    Null 値
'長さ 0 の文字列 ("")      5           -5              0.5
'0                         5           -5              1
'0.00                      5.00        -5.00           0.50
'#,##0                     5           -5              1
'#,##0.00;;;Nil            5.00        -5.00           0.50       Nil
'\\#,##0;\\-#,##0         \5          (\5)            \1
'\\#,##0.00;\\-#,##0.00   \5.00       (\5.00)         \0.50
'0%                        500%        -500%             50%
'0.00%                     500.00%     -500.00%       50.00%
'0.00E+00                  5.00E+00    -5.00E+00       5.00E-01
'0.00E-00                  5.00E00     -5.00E00        5.00E-01
'
'数値表示書式指定文字 (Format 関数)
'
'(0)
'桁位置や桁数を指定するときに使います。引数 format に指定した書式文字列内の表示書式指定文字
'"0" 1 つで、数値の 1 桁を表します。変換対象の数値 (式) が、"0" で指定された桁位置を使ってい
'る場合は、その桁に該当する値が入ります。変換対象の数値の桁数が少なく、指定された桁位置に該
'当する値がない場合は、その桁には 0 が入ります。
'引数 expression に指定した数値の整数部または小数部の桁数が、指定書式内の "0" の桁位置に満
'たない場合は、その桁位置には 0 が付加されます。また、数値の小数部の桁数が小数部に指定した
'"0" の桁位置を超える場合には、数値の小数部は指定の桁位置に合わせて四捨五入されます。逆に、
'整数部の桁数が整数部に指定した "0" の桁位置を超える場合には、整数部は変更されることなく、
'すべて表示されます。
'
'(#)
'桁位置や桁数を指定するときに使います。引数 format に指定した書式文字列内の表示書式指定文字
' "#" 1 つで、数値の 1 桁を表します。変換対象の数値 (expression) が "#" で指定された桁位置
'を使っている場合は、その桁に該当する値が入ります。変換対象の数値の桁数が少なく、指定された
'桁位置に該当する値がない場合は、その桁には何も入りません。
'この記号は表示書式指定文字の "0" と同じような働きをしますが、数値の小数部や整数部の桁数が
'"#" で指定された桁位置に満たない場合に 0 は挿入されず、その桁には何も入りません。
'
'(.)
'表示書式指定文字 ("0" または "#") と組み合わせて、小数点の位置を指定するときに使います。
'表示する桁数を指定するとき、この表示書式指定文字の位置によって、整数部と小数部が区別されま
'す。指定書式内で "." の左側に "#" だけが指定されている場合は、1 未満の数値は小数点記号から
'始まります。数値が 1 未満の場合に小数点記号の左側に常に 0 が付くようにするには、指定書式内
'で " " の左側に "#" ではなく "0" を指定します。変換後の小数点記号は、オペレーティング シス
'テムの国別情報の設定によって決まります。
'
'(%)
'数値を 100 倍し、パーセント記号 (%) を付けるときに指定します。
'
'(,)
'1000 単位の区切り記号を挿入するときに指定します。整数部が 4 桁以上ある数値については、1000
'単位の区切り記号が付きます。変換後の 1000 単位の区切り記号は、オペレーティング システムの国
'別情報の設定によって決まります。通常、この表示書式指定文字 "," の前後に "0" または "#" を指
'定して使います。この表示書式指定文字 "," の右側に "0" も "#" も指定しない場合、つまり、整数
'部の右端にこの表示書式指定文字 "," を 1 つ、または 2 つ以上続けて指定した場合 (小数部の表示
'指定の有無は任意)、変換対象の数値は 1000 単位で割った値に変換されます。このとき、値は桁位置
'の指定に応じて丸められます。たとえば、書式指定文字列として "##0,," と指定すると、
'数値 100000000 (1 億) は、100 に変換されます。100 万未満の数値は 0 となります。整数部の右端
'以外でこの表示書式指定文字 "," を 2 つ以上続けて指定した場合は、"," を 1 つ指定したときと同
'じになります。
'
'(:)
'時刻の区切り記号を挿入するときに指定します。時刻を時間、分、秒で区切ることができます。
'変換後の時刻の区切り記号は、オペレーティング システムの国別情報の設定によって決まります。
'
'(/)
'日付の区切り記号を挿入するときに指定します。日付を年、月、日で区切ることができます。
'変換後の区切り記号は、オペレーティング システムの国別情報の設定によって決まります。
'
'(E- E+ e- e+)
'指数表記で表すときに指定します。"E-"、"E+"、"e-"、"e+" のいずれかの右側に "0" または "#" を
' 1 つ以上指定すると、数値は指数表記で表され、整数部と指数部の間に e または E が挿入されます。
'これらの表示書式指定文字の右側に指定する "0" または "#" の数は、指数部の桁数を示します。"E-"
'や "e-" を使うと、指数が負の場合にはマイナス記号が付きます。"E+" や "e+" の場合は、
'指数の正負に合わせてプラス記号かマイナス記号が付きます。
'
'- + $ ( ) スペース
'指定する文字をそのまま挿入します。これら以外の表示書式指定文字を挿入するには、
'その前に円記号 (\) を付けるか、ダブル クォーテーション (" ") で囲みます。
'
'(\)
'すぐ後に続く 1 文字をそのまま表示します。書式指定の中で、特別な意味を持っている "#" または
' "E" などの文字を文字としてそのまま表示するには、その文字の前に円記号 (\) を付けます。
'この場合、前に付けた円記号 (\) は表示されません。文字をダブル クォーテーション (" ")
'で囲んでも、同じです。円記号 (\) を挿入するには、円記号 (\) を 2 つ続けて記述します (\\)。
'そのままでは挿入できない文字としては、
'日付や時刻の表示書式指定文字 (a、c、d、h、m、n、p、q、s、t、w、y、/、:)、
'数値の表示書式指定文字 (#、0、%、E、e、カンマ、ピリオド)、
'文字列の表示書式指定文字 (@、&、<、>、 ) などがあります。
'
'("ABC")
'ダブル クォーテーション (" ") で囲まれた文字列は、そのまま挿入されます。
'書式指定の引数 format に文字列を含めるには、Chr(34) を使って文字列を囲みます。
'文字コードではダブル クォーテーション (" ") は 34 になります。

  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 指定したファイルの作成日を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function FileDate(PathName As StringAs String
'********************************
'指定したファイルの作成日を返す
'********************************
'返り値はString型
'日付だけを"yyyy/mm/dd"形式で返す
'エラー時は"yyyy/mm/dd"を返す

Dim GetDate As String
On Error GoTo MyERR:
GetDate = FileDateTime(PathName)

FileDate = Format(GetDate, "yyyy/mm/dd")

Exit Function

MyERR:

FileDate = "yyyy/mm/dd"

'FileDateTime 関数
'指定したファイルの作成日時または最後に修正した日時を示す値を返す
'
'構文
'
'FileDateTime (pathname)
'
'引数 pathname は必ず指定します。
'引数 pathname には、ファイル名を示す文字列式を指定します。
'フォルダ名およびドライブ名を含めて指定できます。

End Function


Private Sub test()
MsgBox FileDate(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-アーク-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-アーク-サイン-コサイン-タンジェントを求める
'ArcsinArccosArctangent

Function Arcsin(x) As Double
'***************************************
'アークサイン Arc-Sine を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arcsin = Atn(x / Sqr(-x * x + 1))
End Function


Function Arccos(x) As Double
'***************************************
'アークコサイン Arc-Cosine を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function


Function Arctan(x) As Double
'***************************************
'アークタンジェント Arc-Tangent を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
'※アークタンジェントはVB関数に存在します。
Arctan = Atn(x)
End Function


Private Sub test1()
Debug.Print 4 * Arctan(1)
'3.14159265358979
End Sub

Atn 関数

  • 指定した数値のアークタンジェントを倍精度浮動小数点数型 (Double) で返します。
  • 構文
  • Atn (Number)
  • 引数 number は必ず指定します。
  • 引数 number には、倍精度浮動小数点数型 (Double) の数値または任意の数式を指定します。
  • 解説
  • Atn 関数は、直角三角形の 2 辺の比を引数 (number) として受け取り、対応する角度を返します。
  • ここでいう 2 辺とは、直角をはさむ 2 つの辺を指します。
  • 2 辺の比は、求める角の反対側の辺 (対辺) の長さをもう一方の辺 (底辺、つまり求める角に隣接する側の辺) の長さで割った値です。
  • 戻り値は、-π/2 ~π/2 の範囲の値 (単位はラジアン) になります。
  • 角度の単位を度からラジアンに変換するには、度にπ/180 を掛けます。
  • ラジアンから度に変換するには、ラジアンに 180 / πを掛けます。
  • メモ Atn 関数は Tan 関数の逆三角関数です。
  • Tan 関数は、引数として角度を受け取り、その角度を含む直角三角形の直角をはさむ2辺の比を返します。
  • Atn 関数と、タンジェントの逆数であるコタンジェント (1/タンジェント) の違いに気を付けてください。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 組み込み関数から三角関数-アーク-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'関数 組み込み関数から三角関数-アーク-セカント-コセカン-コタンジェンを求める
'ArcsecArccosecArccotan

Function Arcsec(x) As Double
'**********************************************
'アークセカント Arc-Secant を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arcsec = Atn(x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
End Function


Function Arccosec(x) As Double
'**********************************************
'アークコセカント Arc-Cosecant を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccosec = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
End Function


Function Arccotan(x) As Double
'**********************************************
'アークコタンジェント Arc-Cotangent を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccotan = Atn(x) + 2 * Atn(1)
End Function


Private Sub test1()
Debug.Print 4 * Arccotan(1)
End Sub

  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 四捨五入・切上げ・切捨てVBandVBA

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub RoundingOff()
'**********************************
'四捨五入・切上げ・切捨てVBandVBA
'**********************************

Dim dblPlus(1) As Double
Dim dblMinus(1) As Double

dblPlus(0) = 99.4
dblPlus(1) = 99.5
dblMinus(0) = -99.4
dblMinus(1) = -99.5

'Int 関数
'引数の小数部分を取り除いた整数値を返します。
Debug.Print Int(dblPlus(0))
Debug.Print Int(dblPlus(1))
Debug.Print Int(dblMinus(0))
Debug.Print Int(dblMinus(1))
'     99
'     99
'   -100
'   -100

'Fix 関数
'引数の小数部分を取り除いた整数値を返します。
Debug.Print Fix(dblPlus(0))
Debug.Print Fix(dblPlus(1))
Debug.Print Fix(dblMinus(0))
Debug.Print Fix(dblMinus(1))
'    99
'    99
'   -99
'   -99

'データ型変換関数
'CInt 関数
'値を整数型 (Integer) に変換します。
Debug.Print CInt(dblPlus(0))
Debug.Print CInt(dblPlus(1))
Debug.Print CInt(dblMinus(0))
Debug.Print CInt(dblMinus(1))
'     99
'    100
'    -99
'   -100

'Format 関数
'式を指定した書式に変換し、値を返します。
Debug.Print Format(dblPlus(0), "0")
Debug.Print Format(dblPlus(1), "0")
Debug.Print Format(dblMinus(0), "0")
Debug.Print Format(dblMinus(1), "0")
'     99
'    100
'    -99
'   -100

'Round 関数
'指定された小数点位置で丸めた数値を返します。
'引数2を省略すると、Round 関数は整数値を返します。
Debug.Print Round(dblPlus(0), 0)
Debug.Print Round(dblPlus(1), 0)
Debug.Print Round(dblMinus(0), 0)
Debug.Print Round(dblMinus(1), 0)
'    99
'    100
'    -99
'   -100

'Application.WorksheetFunction
'ワークシート関数を使用する
'Round 四捨五入
'引数2を省略すると、Round 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.Round(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.Round(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.Round(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.Round(dblMinus(1), 0)
'     99
'    100
'    -99
'   -100

'RoundDown 切り捨て
'引数2を省略すると、RoundDown 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.RoundDown(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblMinus(1), 0)
'    99
'    99
'   -99
'   -99

'RoundUp 切り上げ
'引数2を省略すると、RoundUp 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.RoundUp(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblMinus(1), 0)
'    100
'    100
'   -100
'   -100

'プラス正値とマイナス負値の扱いに要注意ですが
'※エクセルが使える環境ですと「Application.WorksheetFunction」
'を使った方が用途が多いですね。

End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 三角関数と逆三角関数-逆三角関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgYZ_DegreeX(ByVal y As DoubleByVal z As Double _
                , ByRef Dgr As DoubleByRef x As Double)
'************************************************
'逆三角関数-正弦yと正接zから角度と余弦xを算出する
'************************************************
'引数 y:正弦 123.456cmなど
'引数 z:正接 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形
'縦位置(Y座標・正弦)÷斜位置(Z座標・正接)=Sine(サイン・正弦)

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = y / z

Dim ARCsin As Double
ARCsin = Atn(ARC / Sqr(-ARC * ARC + 1))

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * ARCsin

Dgr = dblDegree
x = z * Cos(ARCsin)
'x = y / Tan(ARCsin)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgYZ_DegreeX()
    Dim Dgr As Double, x As Double
    Call TrgYZ_DegreeX(14.9982662331051, 18.02775638, Dgr, x)
    Debug.Print Dgr
    Debug.Print x
' 56.3
' 10.0026001668331
End Sub
Option Explicit


'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgXZ_DegreeY(ByVal x As DoubleByVal z As Double _
                , ByRef Dgr As DoubleByRef y As Double)
'************************************************
'逆三角関数-余弦xと正弦zから角度と正弦yを算出する
'************************************************
'引数 x:余弦 123.456cmなど
'引数 z:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形
'横位置(X座標・余弦)÷斜位置(Z座標・正接)=Cosine(コサイン・余弦)

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = x / z

Dim ARCcos As Double
ARCcos = Atn(-ARC / Sqr(-ARC * ARC + 1)) + 2 * Atn(1)

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * ARCcos

Dgr = dblDegree
y = x * Tan(ARCcos)
'y = z * Sin(ARCcos)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgXZ_DegreeY()
    Dim Dgr As Double, y As Double
    Call TrgXZ_DegreeY(10.0026001668331, 18.02775638, Dgr, y)
    Debug.Print Dgr
    Debug.Print y
' 56.3000000000001
' 14.9982662331051
End Sub
Option Explicit


'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgXY_DegreeZ(ByVal x As DoubleByVal y As Double _
                , ByRef Dgr As DoubleByRef z As Double)
'************************************************
'逆三角関数-余弦xと正弦yから角度と正接zを算出する
'************************************************
'引数 x:余弦 123.456cmなど
'引数 y:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形
'縦位置(Y座標・正弦)÷横位置(X座標・余弦)=Tangent(タンジェント・正接)

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = y / x

Dim Arctan As Double
Arctan = Atn(ARC)

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * Arctan

Dgr = dblDegree
z = y / Sin(Arctan)
'z = x / Cos(Arctan)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgXY_DegreeZ()
    Dim Dgr As Double, z As Double
    Call TrgXY_DegreeZ(10.0026001668331, 14.9982662331051, Dgr, z)
    Debug.Print Dgr
    Debug.Print z
' 56.3
' 18.02775638
End Sub


  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 三角関数と逆三角関数-三角関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeZ_YX(ByVal Dgr As DoubleByVal z As Double _
                , ByRef y As DoubleByRef x As Double)
'************************************************
'三角関数-角度と正接zから正弦yと余弦xを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 z:正接 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

y = z * Sin(dblRadian)
x = z * Cos(dblRadian)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgDegreeZ_YX()
    Dim y As Double, x As Double
    Call TrgDegreeZ_YX(56.3, 18.02775638, y, x)
    Debug.Print y
    Debug.Print x
' 14.9982662331051
' 10.0026001668331
End Sub
Option Explicit


'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeX_ZY(ByVal Dgr As DoubleByVal x As Double _
                , ByRef z As DoubleByRef y As Double)
'************************************************
'三角関数-角度と余弦xから正接zと正弦yを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 x:余弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

z = x / Cos(dblRadian)
y = x * Tan(dblRadian)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgDegreeX_ZY()
    Dim z As Double, y As Double
    Call TrgDegreeX_ZY(56.3, 10.0026001668331, z, y)
    Debug.Print z
    Debug.Print y
' 18.02775638
' 14.9982662331051
End Sub
Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeY_ZX(ByVal Dgr As DoubleByVal y As Double _
                , ByRef z As DoubleByRef x As Double)
'************************************************
'三角関数-角度と正弦yから正接zと余弦xを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 y:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件:∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

z = y / Sin(dblRadian)
x = y / Tan(dblRadian)

'縦位置(Y座標・Sine・サイン・正弦)ARCアーク
'横位置(X座標・Cosine・コサイン・余弦)ARCアーク
'斜位置(Z座標・Tangent・タンジェント・正接)ARCアーク

End Function


Private Sub test_TrgDegreeY_ZX()
    Dim z As Double, x As Double
    Call TrgDegreeY_ZX(56.3, 14.9982662331051, z, x)
    Debug.Print z
    Debug.Print x
' 18.02775638
' 10.0026001668331
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 高さと幅から斜線辺を求める-平方根

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

  • yとxから
  • zを求める。
Option Explicit


Function SquareRoot(y As Double, x As DoubleAs Double
'*************************************
'高さと幅から斜線辺を求める-平方根
'*************************************
'正弦と余弦から正接を求める
'引数yには高さ、xには幅
'ピタゴラス

If (x ^ 2 + y ^ 2) > 0 Then
    SquareRoot = Sqr(x ^ 2 + y ^ 2)
Else
    SquareRoot = 0
End If

'Sqr 関数
'数式の平方根を倍精度浮動小数点数型 (Double) の値で返す数値演算関数です。
'
'構文
'Sqr (Number)
'
'引数 number は必ず指定します。
'引数 number には、0 以上の倍精度浮動小数点数型 (Double) の数値または
'任意の有効な数式を指定します。

End Function


Private Sub test()
Debug.Print SquareRoot(15, 10)
'18.0277563773199
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 現在の日付と時間を文字型で返す関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Option Explicit

Public Function DateTimeName() As String

'’現在の日付と時間を文字型で返す関数
'’引数:なし
'’返値:現在の西暦、月日、時分秒を繋げた文字型を返す

DateTimeName = "(" & Year(Date) & Format(Month(Date), "00") & _
Format(Day(Date), "00") & Format(Hour(Time), "00") & _
Format(Minute(Time), "00") & Format(Second(Time), "00") & ")"

End Function

Private Sub Test()
    MsgBox DateTimeName
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 財務に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'減価償却の計算 DDB, SLN, SYD
'将来価値の計算 FV
'利息率を計算 Rate
'内部利益率の計算 IRR, MIRR
'投資期間の計算 NPer
'支払額の計算 IPmt, Pmt, PPmt
'現在価値の計算 NPV, PV
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 データ型変換関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'【CBool】ブール型 (Boolean)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   任意の有効な文字列または数式

'【CByte】バイト型 (Byte)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   0 ~ 255

'【CCur】通貨型 (Currency)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -922,337,203,685,477.5808 ~ 922,337,203,685,477.5807

'【CDate】日付型 (Date)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   任意の有効な日付式

'【CDbl】倍精度浮動小数点数型 (Double)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  -1.79769313486231E308    ~  -4.94065645841247E-324  (負の値)。
'   4.94065645841247E-324   ~   1.79769313486232E308   (正の値)。

'【CDec】10 進型 (Decimal)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   <<小数点以下が 0 桁 (小数部分を持たない数値) の場合>>
'   -79,228,162,514,264,337,593,543,950,335 ~ 79,228,162,514,264,337,593,543,950,335。
'   <<小数点以下 28 桁の数値の場合>>
'   -7.9228162514264337593543950335 ~ 7.9228162514264337593543950335。
'   <<絶対値の最小値は 0 を除いた場合>>
'   0.0000000000000000000000000001。
'
'【CInt】整数型 (Integer)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -32,768 ~ 32,767。小数部分は丸められます。

'【CLng】長整数型 (Long)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -2,147,483,648 ~ 2,147,483,647。小数部分は丸められます。

'【CSng】単精度浮動小数点数型 (Single)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -3.402823E38 ~ -1.401298E-45 (負の値)、および 1.401298E-45 ~ 3.402823E38 (正の値)。

'【CVar】バリアント型 (Variant)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   数値の場合は倍精度浮動小数点数型の範囲と同じ。数値以外の場合は、文字列型の範囲と同じ。

'【CStr】文字列型 (String)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   CStr 関数の戻り値は引数 expression により異なります。

  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 エクセル関数にあってVBAにない関数一覧(三角関数)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

名称 EXCEL VBA
スクエア SQRT Sqr 関数
サイン SIN Sin 関数
コサイン COS Cos 関数
タンジェント TAN Tan 関数
セカント なし Sec(X) = 1 / Cos(X)
コセカント なし Cosec(X) = 1 / Sin(X)
コタンジェント なし Cotan(X) = 1 / Tan(X)
アークサイン ASIN Arcsin(X) = Atn(X / Sqr(-X * X + 1))
アークコサイン ACOS Arccos(X) = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
アークタンジェント ATAN Atn 関数
アークセカント なし Arcsec(X) = Atn(X / Sqr(X * X - 1)) + Sgn((X) - 1) * (2 * Atn(1))
アークコセカント なし Arccosec(X) = Atn(X / Sqr(X * X - 1)) + (Sgn(X) - 1) * (2 * Atn(1))
アークコタンジェント なし Arccotan(X) = Atn(X) + 2 * Atn(1)
双曲線サイン SINH HSin(X) = (Exp(X) - Exp(-X)) / 2
双曲線コサイン COSH HCos(X) = (Exp(X) + Exp(-X)) / 2
双曲線タンジェント TANH HTan(X) = (Exp(X) - Exp(-X)) / (Exp(X) + Exp(-X))
双曲線セカント なし HSec(X) = 2 / (Exp(X) + Exp(-X))
双曲線コセカント なし HCosec(X) = 2 / (Exp(X) - Exp(-X))
双曲線コタンジェント なし HCotan(X) = (Exp(X) + Exp(-X)) / (Exp(X) - Exp(-X))
双曲線アークサイン ASINH HArcsin(X) = Log(X + Sqr(X * X + 1))
双曲線アークコサイン ACOSH HArccos(X) = Log(X + Sqr(X * X - 1))
双曲線アークタンジェント ATANH HArctan(X) = Log((1 + X) / (1 - X)) / 2
双曲線アークセカント なし HArcsec(X) = Log((Sqr(-X * X + 1) + 1) / X)
双曲線アークコセカント なし HArccosec(X) = Log((Sgn(X) * Sqr(X * X + 1) + 1) / X)
双曲線アークコタンジェント なし HArccotan(X) = Log((X + 1) / (X - 1)) / 2
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 Str関数とCStr関数の違い

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub StrAndCStrFunction()
'******************************
'Str関数とCStr関数の違い
'******************************
Dim i As Long

i = 1234 '正の値
Debug.Print Len(i) '4を返す
Debug.Print Len(Str(i)) '5を返す
Debug.Print Len(CStr(i)'4を返す
Debug.Print Len(Trim(Str(i))) '4を返す

i = -1234 '負の値
Debug.Print Len(i)  '4を返す
Debug.Print Len(Str(i))  '5を返す
Debug.Print Len(CStr(i))  '5を返す
Debug.Print Len(Trim(Str(i)))  '5を返す

'Str関数は正の値(プラス値)の場合「+」の代わりにスペースを付加する

End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 Win32-API関数プロセス/スレッドの関数一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

プラットフォーム SDK
[Win32 API 関数]プロセス/スレッドの関数
関数 説明
AssignProcessToJobObject プロセスを既存のジョブオブジェクトに関連付けます。
AttachThreadInput 特定のスレッドの入力処理機構を別のスレッドにアタッチします。
BindIoCompletionCallback スレッドプールの非 I/O ワーカースレッドのキューにコールバック関数を入れます。
CommandLineToArgvW Unicode ワイド文字で渡されたコマンドライン文字列を解析します。
ConvertThreadToFiber 現在のスレッドをファイバに変換します。
CreateFiber ファイバオブジェクトを確保し、そのオブジェクトにスタックを割り当て、指定された開始アドレスから実行を開始するための準備を行います。
CreateJobObject ジョブオブジェクトを作成します。
CreateProcess 新しい 1 個のプロセスと、そのプライマリスレッドを作成します。新しいプロセスは、指定された実行可能ファイルを実行します。
CreateProcessAsUser 新しいプロセスとそのプライマリスレッドを返します。
CreateProcessWithLogonW 新しいプロセスとそのプライマリスレッドを作成します。
CreateRemoteThread 別のプロセスのアドレス空間で稼働するスレッドを作成します。
CreateThread 呼び出し側プロセスの仮想アドレス空間で実行するべき 1 個のスレッドを作成します。
DeleteFiber 既存のファイバを削除します。
ExitProcess 1 つのプロセスと、そのプロセスに所属するすべてのスレッドを終了させます。
ExitThread 1 つのスレッドを終了させます。
FiberProc CreateFiber 関数とともに使うアプリケーション定義関数です。ファイバの開始アドレスの役割を果たします。
FreeEnvironmentStrings 複数の環境文字列からなる 1 個の環境ブロックを解放します。
GetCommandLine 現在のプロセスのコマンドライン文字列へのポインタを取得します。
GetCurrentFiber カレントファイバのアドレスを返します。
GetCurrentProcess 現在のプロセスに対応する疑似ハンドルを取得します。
GetCurrentProcessId 呼び出し側プロセスのプロセス識別子を取得します。
GetCurrentThread 現在のスレッドの擬似ハンドルを取得します。
GetCurrentThreadId 呼び出し側スレッドのスレッド識別子を取得します。
GetEnvironmentStrings 現在のプロセスに対応する環境ブロックへのポインタを取得します。
GetEnvironmentVariable 呼び出し側プロセスの環境ブロックから、指定された環境変数の値を取得します。この値は、NULL で終わる文字列です。
GetExitCodeProcess 指定されたプロセスの終了ステータスを取得します。
GetExitCodeThread 指定されたスレッドの終了ステータスを取得します。
GetFiberData カレントファイバに関連付けられたファイバデータを返します。
GetGuiResources このドキュメントの内容は、まだ確定されていないため将来変更される可能性があります。
GetPriorityClass 指定されたプロセスの優先順位クラスを返します。
GetProcessAffinityMask 指定されたプロセスのプロセスアフィニティマスクとシステムのシステムアフィニティマスクを返します。
GetProcessPriorityBoost 指定されたプロセスのプライオリティブースト制御の状態を返します。
GetProcessShutdownParameters 呼び出し側プロセスのシャットダウンパラメータを取得します。
GetProcessTimes 指定されたプロセスに関する時間情報を取得します。
GetProcessVersion 指定されたプロセスが、実行に当たって想定している Windows のメジャーバージョンとマイナーバージョンを取得します。
GetProcessWorkingSetSize 指定されたプロセスの最大ワーキングセットサイズと最小ワーキングセットサイズを取得します。
GetStartupInfo 呼び出し側プロセスを作成する際に指定された、 構造体の内容を取得します。
GetThreadPriority 指定されたスレッドの相対優先順位値を取得します。
GetThreadPriorityBoost 指定されたスレッドのプライオリティブースト制御の状態を返します。
GetThreadTimes 指定されたスレッドに関する時間情報を取得します。
GetTimestampForLoadedLibrary ロード済みイメージのタイムスタンプを取得します。
OpenJobObject 既存のジョブオブジェクトを開きます。
OpenProcess 既存のプロセスオブジェクトのハンドルを開きます。
OpenThread 既存のスレッドオブジェクトのハンドルを取得します。
QueryInformationJobObject ジョブオブジェクトからリミットとジョブの状態に関する情報を取得します。
QueueUserWorkItem 内のワーカースレッドのキューに作業項目を入れます。
ResumeThread スレッドのサスペンド (中断) カウントを 1 減らします。
SetEnvironmentVariable 現在のプロセスに対応する 1 つの環境変数の値を設定します。
SetInformationJobObject ジョブオブジェクトのリミットを設定します。
SetPriorityClass 指定されたプロセスの優先順位クラスを設定します。
SetProcessAffinityMask 指定したプロセスに属するスレッドのプロセッサアフィニティマスクを設定します。
SetProcessPriorityBoost 指定されたプロセスに属するスレッドについて、特定のスレッドの優先順位を一時的に上げる Windows NT のブースト機能を無効にします。
SetProcessShutdownParameters 呼び出し側プロセスのシャットダウンパラメータを設定します。
SetProcessWorkingSetSize 指定されたプロセスの最小ワーキングセットサイズと最大ワーキングセットサイズを設定します。
SetThreadAffinityMask 指定されたスレッドのプロセッサアフィニティマスクを設定します。
SetThreadIdealProcessor スレッドの優先プロセッサを指定するときに使います。
SetThreadPriority 指定されたスレッドの相対優先順位値を設定します。
SetThreadPriorityBoost スレッドの優先順位を一時的に上げる Windows NT の機能を無効にします。
Sleep 指定された時間にわたって、現在のスレッドの実行を中断します。
SleepEx 現在のスレッドを中断します。次の条件のいずれかが満たされると、実行を再開します。
SuspendThread 指定されたスレッドの実行を中断します。
SwitchToFiber ファイバをスケジューリングします。
SwitchToThread 呼び出し側スレッドから現在のプロセッサで実行する準備ができている別のスレッドに実行を譲渡します。
TerminateJobObject ジョブに関連付けられているすべてのプロセスを終了します。
TerminateProcess 指定されたプロセスと、そのプロセスに所属するすべてのスレッドを終了させます。
TerminateThread 1 つのスレッドを終了させます。
ThreadProc スレッドの開始アドレスの役割を果たすアプリケーション定義関数です。
TlsAlloc スレッドローカル記憶域 (TLS) インデックスを確保します。
TlsFree スレッドローカル記憶域 (TLS) インデックスを解放し、再利用できるようにします。
TlsGetValue TlsGetValue 関数は、呼び出し側スレッドの、指定された TLS インデックスに対応するスレッドローカル記憶域 (TLS) スロットに入っている値を取得します。
TlsSetValue 呼び出し側スレッドの、指定された TLS インデックスに対応するスレッドローカル記憶域 (TLS) スロットに値を入れます。
UserHandleGrantAccess ユーザーインターフェイス制限の付いたジョブに USER ハンドルへのアクセス権を与えます。
WaitForInputIdle 指定されたプロセスで未処理の入力が存在せず、ユーザーからの入力を待っている状態になるまで、またはタイムアウト時間が経過するまで待機します。
WinExec 指定されたアプリケーションを実行します。
Yield 16 ビット版 Windows との互換性を維持するためだけに残されているもので、今後廃止されます。Win32 ベースのアプリケーションプログラミングインターフェイス (API) では、この関数は何もしません。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 関数名にドル記号($)は何か?

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub FunctionDollarMark()
'********************************
'関数名にドル記号($)は何か?
'********************************
'ペルプ抜粋

'次の関数は関数名にドル記号 ($) を追加すると、文字列型 (String) の値を返します。
'これらの関数は、ドル記号を付けずに使用すると、バリアント型 (Variant) の値を返します。

'Chr$
'ChrB$
'CurDir$
'Date$
'Dir$
'Error$
'Format$
'Hex$
'Input$
'InputB$
'LCase$
'Left$
'LeftB$
'LTrim$
'Mid$
'MidB$
'Oct$
'Right$
'RightB$
'RTrim$
'Space$
'Str$
'String$
'Time$
'Trim$
'UCase$

'バリアント型 (Variant) を返す形式
    '*異なるデータ型への変換が自動的に行われるので便利です。
    '*この形式を使用すると、Null 値を式で渡すことができます。
'文字列型 (String) を返す形式
    '*使用するメモリが少ないため、より効率的です。

End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 円周率(π)ディグリー(角度)ラジアンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function vbPI() As Double
'**********************************
'円周率(π)を求る
'**********************************
'Atn関数を利用(アークタンジェント)
'VB・VBAには円周率関数が無い
'返値=近似値

    'ワークシート関数を使わないで求める
    vbPI = 4 * Atn(1)

'※エクセルVBAの場合、ワークシート関数からでも求める事が可能
'vbPI = Application.WorksheetFunction.PI
End Function


Function Radian(Degrees As DoubleAs Double
'**********************************
'ディグリー(角度)からラジアンを求る
'**********************************
'返値=近似値
'ラジアン=円周率÷180×ディグリー
'円周率π=3.14159265358979

    Radian = (vbPI / 180) * Degrees

End Function


Function Degree(Radian As DoubleAs Double
'**********************************
'ラジアンからディグリー(角度)を求る
'**********************************
'返値=近似値
'ディグリー=円周率÷180×ラジアン
'円周率π=3.14159265358979

    Degree = (180 / vbPI) * Radian

End Function


Private Sub test()
''円周率πを求る
Debug.Print vbPI()
'3.14159265358979

''ディグリー(角度)からラジアンを求る
Debug.Print Radian(90)
'1.5707963267949

''ラジアンからデグリー(角度)を求る
Debug.Print Degree(1.5707963267949)
'90.0000000000002

End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 逆三角関数x-y座標のアークタンジェントを返しますAtan2無使用

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function Atan2VBversion(x As Double, y As DoubleAs Double
'**********************************************************
'逆三角関数x-y座標のアークタンジェントを返しますAtan2無使用
'**********************************************************
'戻り値の角度は度
'引数x:x座標を指定
'引数y:y座標を指定
'※エクセルWorksheetFunctionAtan2無使用

    Dim vPI As Double, At2 As Double
    vPI = 4 * Atn(1) '円周率(π)
    If x > 0 Then
        At2 = Atn(y / x)
    ElseIf x < 0 Then
        At2 = Sgn(y) * (vPI - Atn(Abs(y / x)))
    ElseIf y = 0 Then
        At2 = 0
    Else
        At2 = Sgn(y) * vPI / 2
    End If
    '====================================
    'ラジアン値が必要な場合は削除       |
    'ラジアンからディグリー(角度)を求る |
    At2 = (180 / vPI) * At2 '           |
    '====================================
    Atan2VBversion = At2

End Function


Function Atan2XLSversion(x As Double, y As DoubleAs Double
'**********************************************************
'逆三角関数x-y座標のアークタンジェントを返します
'**********************************************************
'戻り値の角度は度
'引数x:x座標を指定
'引数y:y座標を指定
'※エクセルWorksheetFunctionAtan2使用

    Dim At2 As Double

    At2 = Application.WorksheetFunction.Atan2(x, y)

    '====================================================
    'ラジアン値が必要な場合は削除                       |
    'ラジアンからディグリー(角度)を求る                 |
    At2 = Application.WorksheetFunction.Degrees(At2) '  |
    '====================================================
    Atan2XLSversion = At2

End Function


Private Sub test()
    Debug.Print Atan2VBversion(10, 15)
    Debug.Print Atan2XLSversion(10, 15)
' 56.3099324740202
' 56.3099324740202

End Sub

Atan2

  • ワークシート関数
  • 指定された x-y 座標のアークタンジェントを返します。
  • アークタンジェントとは、x 軸から、原点 0 と x座標、y座標 で表される点を結んだ直線までの角度のことです。
  • 戻り値の角度は、-PI ~ PI (ただし -PI を除く) の範囲のラジアンとなります。
  • 書式
  • ATAN2(x座標, y座標)
  • x座標 点の x 座標を指定します。
  • y座標 点の y 座標を指定します。
  • 解説
  • 戻り値が正の数なら x 軸から反時計回りの角度を表し、負の数なら x 軸から時計回りの角度を表します。
  • ATAN2(a,b) = ATAN(b/a) という関係になりますが、ATAN2 関数では、a に 0 を指定することができます。
  • x座標 と y座標 が両方とも 0 である場合、エラー値 #DIV/0 が返されます。
  • アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
  • 使用例
  • ATAN2(1, 1) = 0.785398 (PI/4 ラジアン)
  • ATAN2(-1, -1) = -2.35619 (-3*PI/4 ラジアン)
  • ATAN2(-1, -1)*180/PI() = -135 (度)

Atn 関数

  • 指定した数値のアークタンジェントを倍精度浮動小数点数型 (Double) で返します。
  • 構文
  • Atn (Number)
  • 引数 number は必ず指定します。引数 number には、倍精度浮動小数点数型 (Double) の数値または任意の数式を指定します。
  • 解説
  • Atn 関数は、直角三角形の 2 辺の比を引数 (number) として受け取り、対応する角度を返します。
  • ここでいう 2 辺とは、直角をはさむ 2 つの辺を指します。
  • 2 辺の比は、求める角の反対側の辺 (対辺) の長さをもう一方の辺 (底辺、つまり求める角に隣接する側の辺) の長さで割った値です。
  • 戻り値は、-π/2 ~π/2 の範囲の値 (単位はラジアン) になります。
  • 角度の単位を度からラジアンに変換するには、度にπ/180 を掛けます。ラジアンから度に変換するには、ラジアンに 180/πを掛けます。
  • メモ
  • Atn 関数は Tan 関数の逆三角関数です。
  • Tan 関数は、引数として角度を受け取り、その角度を含む直角三角形の直角をはさむ 2 辺の比を返します。
  • Atn 関数と、タンジェントの逆数であるコタンジェント (1/タンジェント) の違いに気を付けてください。

Sgn 関数

  • 引数に指定した値の符号をバリアント型 (内部処理形式 Integer の Variant) の値で返す数値演算関数です。
  • 構文
  • Sgn(number)
  • 引数
  • number は必ず指定します。引数 number には、任意の数式を指定します。
  • 戻り値
  • number の値 戻り値
  • number > 0 1
  • number = 0 0
  • number < 0 -1
  • 解説
  • 引数 number の符号により、Sgn 関数の戻り値が決まります。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 MsgBox関数の引数の値と戻り値

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MsgBox 関数の定数
MsgBox 関数の引数の値
定数 内容
vbOKOnly 0 (既定値) [OK] ボタンのみを表示します。
vbOKCancel 1 [OK] ボタンと [キャンセル] ボタンを表示します。
vbAbortRetryIgnore 2 [中止]、[再試行]、[無視] の 3 つのボタンを表示します。
vbYesNoCancel 3 [はい]、[いいえ]、[キャンセル] の 3 つのボタンを表示します。
vbYesNo 4 [はい] ボタンと [いいえ] ボタンを表示します。
vbRetryCancel 5 [再試行] ボタンと [キャンセル] ボタンを表示します。
vbMsgBoxHelpButton 16384 ヘルプ ボタンを追加します。
vbCritical 16 警告メッセージ アイコンを表示します。
vbQuestion 32 問い合わせメッセージ アイコンを表示します。
vbExclamation 48 注意メッセージ アイコンを表示します。
vbInformation 64 情報メッセージ アイコンを表示します。
vbDefaultButton1 0 (既定値)第 1 ボタンを標準ボタンに設定します。
vbDefaultButton2 256 第 2 ボタンを標準ボタンに設定します。
vbDefaultButton3 512 第 3 ボタンを標準ボタンに設定します。
vbDefaultButton4 768 第 4 ボタンを標準ボタンに設定します。
vbApplicationModal 0 (既定値)アプリケーション モーダルに設定します。
vbSystemModal 4096 システム モーダルに設定します。
VbMsgBoxSetForeground 65536 最前面のウィンドウとして表示します。
vbMsgBoxRight 524288 テキストを右寄せで表示します。
vbMsgBoxRtlReading 1048576 テキストを、右から左の方向で表示します。
MsgBox 関数の戻り値
定数 内容 (選択されたボタン)
vbOK 1 [OK]
vbCancel 2 [キャンセル]
vbAbort 3 [中止]
vbRetry 4 [再試行]
vbIgnore 5 [無視]
vbYes 6 [はい]
vbNo 7 [いいえ]
Option Explicit


Sub MsgboxTest()
Dim msg As Variant, str As String

str = "MsgboxTest"

    msg = MsgBox("あいうえお", vbYesNoCancel + 64 + 524288 + 512, str)

    If msg = 7 Then
        MsgBox "[いいえ]が選択されました", 16, str
    ElseIf vbCancel Then
        MsgBox "[キャンセル]が選択されました", 48, str
    End If

End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 Hex関数16進数で表した文字列と逆変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

10 進数の場合 16 進数の場合
000000 000000
000001 000001
000002 000002
000003 000003
000004 000004
000005 000005
000006 000006
000007 000007
000008 000008
000009 000009
000010 00000A
000011 00000B
000012 00000C
000013 00000D
000014 00000E
000015 00000F
000016 000010
000017 000011
000018 000012
16777215 FFFFFF
Option Explicit


Sub HexTest()
'***************************************
'Hex関数16進数で表した文字列と逆変換
'***************************************
Dim i As Byte
For i = 0 To 18
Debug.Print "[ " & Right("000000" & Hex(i), 6) & " ]"
Next i
Debug.Print "[ " & CLng("&H" & "000000") & " ]"
Debug.Print "[ " & CLng("&H" & "FFFFFF") & " ]"
'[ 000000 ]
'[ 000001 ]
'[ 000002 ]
'[ 000003 ]
'[ 000004 ]
'[ 000005 ]
'[ 000006 ]
'[ 000007 ]
'[ 000008 ]
'[ 000009 ]
'[ 00000A ]
'[ 00000B ]
'[ 00000C ]
'[ 00000D ]
'[ 00000E ]
'[ 00000F ]
'[ 000010 ]
'[ 000011 ]
'[ 000012 ]
'[ 0 ]
'[ 16777215 ]
End Sub

Hex 関数

指定した値を 16 進数で表した文字列型 (String) を返します。

  • 構文

  • Hex(number)
  • 引数 number には

    、任意の数式または文字列式を指定します。この引数は必ず指定します。
  • 解説

  • 引数 number が整数でない場合、変換の前に一番近い整数に丸められます。
  • number の値 戻り値

  • Null 値 Null 値
  • Empty 値 0
  • その他の数値 16 進数を表す最大 8 桁の文字列
  • 適切な範囲の数値の前に &H を付けて記述すると、値を直接 16 進数で記述することができます。
  • たとえば、10 進数の 16 を &H10 のように 16 進数で表記することができます。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 LBound(小)関数とUBound(大)関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

LBound 関数

配列の指定された次元で使用できる最小の添字を、長整数型 (Long)の値で返します。

  • 構文

  • LBound(arrayname[, dimension])
  • LBound 関数の構文は、次の指定項目から構成されます。
  • 指定項目 内容

  • arrayname
    必ず指定します。配列変数の名前です。変数の標準的な名前付け規則に従って指定します。
  • dimension
    省略可能です。バリアント型 (内部処理形式 Long の Variant) の値を指定します。添字の最小値を調べる対象となる配列の次元を示す整数を指定します。最初の次元なら 1、2 番目の次元なら 2、というように指定します。引数 dimension を省略すると、1 が指定されたものと見なされます。
  • 解説

  • LBound 関数
    は、UBound 関数と組み合わせて、配列のサイズを調べるために使います。配列の添字の最大値を調べるには、UBound 関数を使います。
  • 次のような配列が宣言されている場合
    、LBound 関数からは下の表のような値が返ります。
  • Dim A(1 To 100, 0 To 3, -3 To 4)
  • ステートメント 戻り値
  • LBound(A, 1) 1
  • LBound(A, 2) 0
  • LBound(A, 3) -3
  • 配列の添字の最小値の既定値は、0 または 1 です。
    この値は、Option Base ステートメントの設定によって決まります。Array 関数で作成された配列の添字は、0 から始まり、Option Base ステートメントの影響は受けません。
  • Dim、Private、Public、ReDim、Static のいずれかのステートメントで To 節を使って配列の次元を設定すると、添字の最小値に任意の整数値を指定できます。

LBound 関数の使用例

次の例では、LBound 関数を使って、配列内の指定された次元の添字として使える最小値を求めます。配列の添字の既定の最小値 0 を変更するには、Option Base ステートメントを使います。
Option Explicit

Dim Lower
    ' 配列変数を宣言します。
Dim MyArray(1 To 10, 5 To 15, 10 To 20)
Dim AnyArray(10)
Lower = LBound(MyArray, 1)     ' 1 を返します。
Lower = LBound(MyArray, 3)     ' 10 を返します。
Lower = LBound(AnyArray)
            ' Option Base の設定に応じて、0 または 1 を返します。

UBound 関数

配列の指定された次元で使用できる添字の最大値を、長整数型 (Long) の値で返します。

  • 構文

  • UBound(arrayname[, dimension])
  • UBound 関数の構文は、次の指定項目から構成されます。
  • 指定項目 内容

  • arrayname
    必ず指定します。配列変数の名前です。変数の標準的な名前付け規則に従って指定します。
  • dimension
    省略可能です。バリアント型 (内部処理形式 Long の Variant) の値を指定します。添字の最大値を調べる対象となる配列の次元を示す整数を指定します。最初の次元なら 1、2 番目の次元なら 2、というように指定します。引数 dimension を省略すると、1 が指定されたものと見なされます。
  • 解説

  • UBound 関数
    は、LBound 関数と組み合わせて、配列のサイズを調べるために使います。配列の添字の最小値を調べるには、LBound 関数を使います。
  • 次のような配列が宣言されている場合
    、UBound 関数からは下の表のような値が返ります。
  • Dim A(1 To 100, 0 To 3, -3 To 4)
  • ステートメント 戻り値
  • UBound(A, 1) 100
  • UBound(A, 2) 3
  • UBound(A, 3) 4

UBound 関数の使用例

次の例では、UBound 関数を使って、配列の指定された次元の添字として使える最大値を求めます。
Option Explicit

Dim Upper
Dim MyArray(1 To 10, 5 To 15, 10 To 20)
                                ' 配列変数を宣言します。
Dim AnyArray(10)
Upper = UBound(MyArray, 1)      ' 10 が返ります。
Upper = UBound(MyArray, 3)      ' 20 が返ります。
Upper = UBound(AnyArray)        ' 10 が返ります。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 FreeFile関数_使用可能なファイル番号を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

FreeFile 関数

使用可能なファイル番号を整数型 (Integer) の値で返すファイル入出力関数です。

  • 構文

  • FreeFile[(rangenumber)]
  • 引数

  • rangenumber
    には、ファイル番号の範囲をバリアント型 (Variant) で指定します。指定した範囲から次に使用可能なファイル番号を返します。この引数は省略可能です。
  • 0 (既定値)1 ~ 255 の範囲のファイル番号が返されます。
  • 1256 ~ 511 の範囲のファイル番号が返されます。
  • 解説

  • 使用可能なファイル番号を取得するために FreeFile 関数を使用します。既に使われているファイル番号を重複して使うのを防ぐことができます。

FreeFile 関数の使用例

次の例は、FreeFile 関数を使って、次に使用可能なファイル番号を返します。この例では、ループ内で 5 つのファイルをシーケンシャル出力モード (Output) で開いています。各ファイルには、サンプル データが書き込まれているものと仮定します。
Option Explicit

Dim MyIndex, FileNumber
' ループを 5 回繰り返します。
For MyIndex = 1 To 5
    ' 未使用のファイル番号を取得します。
    FileNumber = FreeFile
    ' ファイル名を作成します。
    Open "TEST" & MyIndex For Output As #FileNumber
    ' 文字列を出力します。
    Write #FileNumber, "これはサンプルです。"
    ' ファイルを閉じます。
    Close #FileNumber
Next MyIndex

  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 EOF関数ファイルの終端(末尾)かどうかを確認する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

EOF 関数

ランダム アクセス モード (Random) またはシーケンシャル入力モード (Input) で開いたファイルの現在位置がファイルの末尾に達している場合、ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。

  • 構文

  • EOF(filenumber)
  • 引数

  • filenumber
    には、任意の有効なファイル番号を表す整数型 (Integer) の数値を指定します。この引数は必ず指定します。
  • 解説

  • EOF 関数は、ファイルから読み込みを行っているとき、読み込み位置がファイルの末尾に達していないかどうかを確かめるために使用します。
  • EOF 関数はファイルの末尾に達していない場合は、偽 (False) を返します。ランダム アクセス モード (Random) またはバイナリ モード (Binary) でファイルを開いた場合、EOF 関数は最後に実行された Get ステートメントでレコード全体が読み込めなくなるまで偽 (False) を返します。
  • バイナリ モードでファイルを開いた場合、Input 関数を使用して EOF 関数が真 (True) を返すまでファイルを読み込もうとすると、エラーが発生します。Input 関数を使用してバイナリ ファイルを読み込む場合は、EOF 関数の代わりに、LOF 関数および Loc 関数を使用します。EOF 関数を使用する場合は、Get ステートメントを使用します。シーケンシャル出力モード (Output) で開いたファイルの場合は、常に真 (True) を返します。

EOF 関数の使用例

次の例は、EOF 関数を使って、ファイルの終端に達したかどうかを調べます。この例では、ファイル MYFILE は、複数行のデータを含むテキスト ファイルと仮定します。
Option Explicit

Dim InputData
' シーケンシャル入力モードで開きます。
Open "MYFILE" For Input As #1
' ファイルの終端かどうかを確認します。
Do While Not EOF(1)
    ' データ行を読み込みます。
    Line Input #1, InputData
    ' イミディエイト ウィンドウに表示します。
    Debug.Print InputData
Loop
' ファイルを閉じます。
Close #1

  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 Functionステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'Function プロシージャの名前、引数、および本体部分を構成するコードを宣言します。()
'
'構文
'
'[Public | Private | Friend] [Static] Function name [(arglist)] [As type]
'[statements]
'[name = expression]
'[Exit Function]
'[statements]
'[name = expression]
'
'
'Function ステートメントの構文は、次の指定項目から構成されます。()
'
'指定項目
'Public
'Private
'Friend
'Static
'name
'arglist
'type
'statements
'expression
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'解説
'
'キーワード Public、キーワード Private、またはキーワード Friend を指定しない場合、Function プロシージャはパブリックが既定値になります。キーワード Static を指定しない場合、ローカル変数の値は Function プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラス モジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプ ライブラリには書き込まれません。また、実行時バインディングは行えません。
'
'メモ Function プロシージャは、再帰的な使用、つまり、ある機能を実行するためにプロシージャ自体を呼び出すことができます。ただし、再帰呼び出しを行うと、スタックがオーバーフローする可能性があります。通常、キーワード Static は、再帰的な Function プロシージャでは使いません。
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。Function プロシージャは、ほかの Function プロシージャ、Sub プロシージャ、Property プロシージャの中では、定義できません。
'
'Exit Function ステートメントは、Function プロシージャを直ちに終了します。プログラムの実行は、その Function プロシージャを呼び出したステートメントの次のステートメントから継続されます。Exit Function ステートメントは、Function プロシージャ内の任意の場所で必要に応じていくつでも指定できます。
'
'Sub プロシージャと同様に、Function プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更します。ただし、Sub プロシージャとは異なり、Function プロシージャは、Sqr、Cos、Chr などの組み込み関数と同じように、式の右辺に記述して、関数の戻り値を使うことができます。
'
'式の中で Function プロシージャを呼び出すには、関数名の後にかっこで囲んだ引数リストを付けて使います。Function プロシージャを呼び出す方法については、Call ステートメントを参照してください。
'
'Function プロシージャから値を返すには、値を Function プロシージャ名に代入します。プロシージャ名には、Function プロシージャ内の任意の場所で、必要に応じて何回でも値を代入できます。プロシージャ名 name に値を代入しない場合、既定の戻り値が返されます。既定の戻り値は、Function プロシージャが数値型の場合は 0、文字列型の場合は長さ 0 の文字列 ("")、バリアント型の場合は Empty 値です。オブジェクトへの参照を返す Function プロシージャでは、プロシージャ内で Set ステートメントを使ってプロシージャ名 name にオブジェクトへの参照を代入しない場合は、Nothing が返されます。
'
'次の例では、BinarySearch という名前の Function プロシージャに戻り値を代入しています。ここでは、値が見つからなかったことを示す偽 (False) をプロシージャ名に代入しています。
'
'Function BinarySearch(. . .) As Boolean
'. . .
    ' 値が見つからないときは偽 (False) を返します。
    If lower > upper Then
        BinarySearch = False
        Exit Function
    End If
'. . .


'Function プロシージャで使う変数には、Function プロシージャ内で明示的に宣言される変数と、それ以外の変数の 2 種類があります。プロシージャ内で Dim などのステートメントで明示的に宣言された変数 (ローカル変数) は、そのプロシージャの中だけで有効です。プロシージャ内で明示的に宣言されていない変数も、そのプロシージャの外部のさらに上のレベルで明示的に宣言されていない限り、ローカル変数となります。
'
'メモ プロシージャ内で明示的に宣言されていない変数をプロシージャ内で使うことは可能ですが、その変数と同じ名前の変数などがモジュール レベルで定義されている場合、名前の競合が発生します。あるプロシージャから、ほかのプロシージャ、定数または変数のいずれかと同じ名前を持つ未宣言の変数を参照した場合、そのモジュール レベルの名前を参照しているものと見なされます。変数を明示的に宣言すれば、このような名前の競合は避けられます。Option Explicit ステートメントを使うと、変数の明示的な宣言が強制されます。
'
'メモ Visual Basic では、演算効率を高めるために数式が自動的に並べ替えられることがあります。数式の中で使用している変数の値を変えてしまうような Function プロシージャは、同じ数式の中で実行しないようにしてください。

'Function ステートメントの使用例

'次の例では、Function ステートメントを使って、Function プロシージャの名前と引数を宣言し、プロシージャのコードを記述しています。最後の例では、既に定義されて、初期化された、キーワード Optional 指定の引数が使われています。

' 次のユーザー定義関数は、引数として渡された値の平方根を返します。
Function CalculateSquareRoot(NumberArg As Double) As Double
    If NumberArg < 0 Then            ' 引数を評価します。
        Exit Function    ' 終了して、呼び出し側のプロシージャに戻ります。
    Else
        CalculateSquareRoot = Sqr(NumberArg)
                                    ' 平方根を返します。
    End If
End Function

'関数が任意の数の引数を受け取るようにするには、キーワード ParamArray を使います。その例を次に示します。また、この例では、引数 FirstArg を値渡しで引き渡します。

Function CalcSum(ByVal FirstArg As Integer, ParamArray OtherArgs())
Dim ReturnValue

ReturnValue = CalcSum(4, 3, 2, 1)
' この関数を上のように呼び出すと、
' 配列の添字の最小値が既定値の 1 であれば、
' ローカル変数には FirstArg = 4、OtherArgs(1) = 3、
' OtherArgs(2) = 2 のように値が代入されます。
End Function

'キーワード Optional が指定された引数は、既定値とバリアント型 (Variant) 以外のデータ型を持つことができます。

' 関数の引数が次のように定義されているものとします。
Function MyFunc(MyStr As StringOptional MyArg1 As _
    Integer = 5, Optional MyArg2 = "Dolly")
Dim RetVal
' この関数は次のように呼び出すことができます。
RetVal = MyFunc("Hello", 2, "World")
                                ' 3 つの引数をすべて指定します。
RetVal = MyFunc("Test", , 5)    ' 2 番目の引数を省略します。
' 名前付き引数を使って、1 番目と 3 番目の引数を指定します。
RetVal = MyFunc(MyStr:="Hello ", MyArg1:=7)
End Function
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 [WorksheetFunction.VLookup]の便利な使い方

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Public Function WorksheetFunctionVLookup(ByVal Geton As StringAs String
'********************************************
'[WorksheetFunction.VLookup]の便利な使い方VBA
'********************************************
Dim str(1 To 3, 1 To 5) As String, Ans As String

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Dim str(3, 5) As String
'注意 下記は上記と同じ変数ですが
'「Application.WorksheetFunction.VLookup」を使用する場合
'は上記のように範囲を1から○○までと指定しないと使えません。
'これはWorksheetFunctionではセル値に「0」が無く「1」から始まる為です。
'追記 str(3, 5)はstr(0 to 3, 0 to 5)と同じです。

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'テーブル----------------------------------------------------------------------------
str(1, 1) = 1: str(1, 2) = "い": str(1, 3) = "A": str(1, 4) = "あ": str(1, 5) = "a"
str(2, 1) = 2: str(2, 2) = "ろ": str(2, 3) = "B": str(2, 4) = "い": str(2, 5) = "b"
str(3, 1) = 3: str(3, 2) = "は": str(3, 3) = "C": str(3, 4) = "う": str(3, 5) = "c"
'------------------------------------------------------------------------------------

Ans = ""
  On Error Resume Next ' エラーのトラップを留保します。
    Ans = Application.WorksheetFunction.VLookup(Geton, str(), 4, False)
  On Error GoTo 0 'エラーのトラップを無効にします。

WorksheetFunctionVLookup = Ans

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'VLOOKUP(検索値, 範囲, 列番号, 検索の型)
'
'検索値:範囲 の左端の列で検索する値を指定します。
'検索値には、値、セル参照、または文字列を指定します。
'英字の大文字と小文字は区別されません。
'
'範囲:目的のデータが含まれるテーブルを指定します。
'範囲の左端の列のデータは、文字列、数値、論理値のいずれでもかまいません。
'
'列番号:範囲内で目的のデータが入力されている列を、左端からの列数で指定します。
'列番号 に 1 を指定すると、範囲の左端の列の値が返され、
'列番号 に 2 を指定すると、範囲の左から 2 列目の値が返されます。
'列番号 が 1 より小さいときは、エラー値 #VALUE! が返され、
'列番号 が 範囲 の列数より大きいときは、エラー値 #REF! が返されます。
'
'検索の型 に TRUE を指定した場合、
'範囲の左端の列のデータは、昇順に並べ替えておく必要があります。
'検索の型に FALSE を指定した場合は、範囲のデータを並べ替えておく必要はありません。
'検索の型 検索値 と完全に一致する値だけを検索するか、
'その近似値を含めて検索するかを、論理値で指定します。
'TRUE を指定するか省略すると、検索値 が見つからない場合に、
'検索値 未満で最も大きい値が使用されます。
'FALSE を指定すると、検索値 と完全に一致する値だけが検索され、
'見つからない場合は エラー値 #N/A が返されます。
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Function



Private Sub test()
    MsgBox WorksheetFunctionVLookup("3")
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

関数 高さと幅から斜線辺を求める-平方根

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

  • yとxから
  • zを求める。
Option Explicit


Function SquareRoot(y As Double, x As DoubleAs Double
'*************************************
'高さと幅から斜線辺を求める-平方根
'*************************************
'正弦と余弦から正接を求める
'引数yには高さ、xには幅
'ピタゴラス

If (x ^ 2 + y ^ 2) > 0 Then
    SquareRoot = Sqr(x ^ 2 + y ^ 2)
Else
    SquareRoot = 0
End If

'Sqr 関数
'数式の平方根を倍精度浮動小数点数型 (Double) の値で返す数値演算関数です。
'
'構文
'Sqr (Number)
'
'引数 number は必ず指定します。
'引数 number には、0 以上の倍精度浮動小数点数型 (Double) の数値または
'任意の有効な数式を指定します。

End Function


Private Sub test()
Debug.Print SquareRoot(15, 10)
'18.0277563773199
End Sub
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:[関数]

ピタゴラスの定理:3章-アーク編

ピタゴラス
  1. アーク
    1. もう一つの三角関数"逆三角関数"「アーク」
    2. 表記方法
    3. もっと判り易くエクセルで説明
    4. 応用をしてみます。
    5. 角度をアークで求めます
この章は「ピタゴラスの定理:2章-2D編-図解」の続編です。

アーク

もう一つの三角関数"逆三角関数"「アーク」

  • サイン・コサイン・タンジェントの他にそれらの文字の頭に「アーク」が付加する、
  • アークサイン・アークコサイン・アークタンジェントがあります。
  • サイン・コサイン・タンジェントはシータθ(角度)からX辺(コサイン)の長さやY辺(サイン)の長さを算出しましたが、
  • アークサイン・アークコサイン・アークタンジェントはサイン・コサイン・タンジェントからシータθ(角度)を算出します。
  • これらを逆三角関数と呼びます。
  • 英名では Inverse Trigonometric Function
  • サイン・コサイン・タンジェントの「逆数」コセカント・セカント・コタンジェントとは全く違います。混同しないように!
    • 逆数とは
    • "x / y" → "y / x" , "z / y" → "y / z" のように式が逆になることです。
  • ACOS
    • ARCCOS
    • 数値のアークコサインを返します。
    • アークコサインとは、そのコサインが 数値 であるような角度のことです。
    • 戻り値の角度は、0(ゼロ) ~ PI の範囲のラジアンとなります。
    • 書式
      • ACOS(数値)
      • 数値 求める角度のコサインの値を、-1 ~ 1 の範囲で指定します。
      • アークコサインの値を度で表すには、計算結果に 180/PI() を掛けます。
      • 使用例
        • ACOS(-0.5) = 2.094395 (2PI/3 ラジアン)
        • ACOS(-0.5) = 120 (度)
  • ASIN
    • ARCSIN
    • 数値のアークサインを返します。
    • アークサインとは、そのサインが 数値 であるような角度のことです。
    • 戻り値の角度は、-PI/2 ~ PI/2 の範囲のラジアンとなります。
    • 書式
      • ASIN(数値)
      • 数値 求める角度のサインの値を、-1 ~ 1 の範囲で指定します。
      • アークサインの値を度で表すには、計算結果に 180/PI() を掛けます。
      • 使用例
        • ASIN(-0.5) = -0.5236 (-PI/6 ラジアン)
        • ASIN(-0.5)*180/PI() = -30 (度)
  • ATAN
    • ARCTAN
    • 数値のアークタンジェントを返します。
    • アークタンジェントとは、そのタンジェントが 数値 であるような角度のことです。
    • 戻り値の角度は、-PI/2 ~ PI/2 の範囲のラジアンとなります。
    • 書式
      • ATAN(数値)
      • 数値 求める角度のタンジェントの値を指定します。
      • アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
      • 使用例
        • ATAN(1) = 0.785398 (PI/4 ラジアン)
        • ATAN(1)*180/PI() = 45 (度)
  • ATAN2
    • 指定された x-y 座標のアークタンジェントを返します。
    • アークタンジェントとは、x 軸から、原点 0 と x座標、y座標 で表される点を結んだ直線までの角度のことです。
    • 戻り値の角度は、-PI ~ PI (ただし -PI を除く) の範囲のラジアンとなります。
    • 書式
      • ATAN2(x座標, y座標)
      • x座標, 点の x 座標を指定します。
      • y座標, 点の y 座標を指定します。
      • 戻り値が正の数なら x 軸から反時計回りの角度を表し、負の数なら x 軸から時計回りの角度を表します。
      • ATAN2(a,b) = ATAN(b/a) という関係になりますが、ATAN2 関数では、a に 0 を指定することができます。
      • x座標 と y座標 が両方とも 0 である場合、エラー値 #DIV/0 が返されます。
      • アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
      • 使用例
        • ATAN2(1, 1) = 0.785398 (PI/4 ラジアン)
        • ATAN2(-1, -1) = -2.35619 (-3*PI/4 ラジアン)
        • ATAN2(-1, -1)*180/PI() = -135 (度)

表記方法

関数の記号の右上に「−1」を付ける
アークコサイン cos -1
 
アークサイン sin -1
 
アークタンジェント tan -1
 

もっと判り易くエクセルで説明

  •   A B C
    1 角度 90 説明
    2 RADIANS 1.570796327 ラジアンを求める
    3 Cosine(x座標) 6.12574E-17  
    4 Sine(y座標) 1  
    5  Tangent(z座標) 1.63246E+16 ( = y / x )
    6 ARCCosine(角度) 90  
    7 ARCSine(角度) 90  
    8 ARCTangent(角度) 90 ( = y / x )
  • 上記はピタゴラスの定理:1章-2D編-図解で使ったものに数式を追加したものです。
  • 又上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
  • 下記はその数式を写しました。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください
  •   A B C
    1
    角度 90 説明
    RADIANS =RADIANS(B1) ラジアンを求める
    Cosine(x座標) =COS(B2)  
    Sine(y座標) =SIN(B2)  
    Tangent(z座標) =TAN(B2) ( = y / x )
    ARCCosine(角度) =DEGREES(ACOS(B3))  
    ARCSine(角度) =DEGREES(ASIN(B4))  
    ARCTangent(角度) =DEGREES(ATAN(B5)) ( = y / x )
    2
    3
    4
    5
    6
    7
    8
  • セル「B1」の値(現在は「90」が入力されています)を変えてみて下さい。

応用をしてみます。

  • 三角関数が判れば逆三角関数の「アーク」はもっと簡単です。
  • 前章のピタゴラスの定理:2章-2D編-図解の応用からです。
  • 直角三角形3種類の1つ∠角と1つの辺で残りの辺を求める式です。
  • 「三角関数を使う」という条件です。※算出方法は他にもあります。
  • エクセルサンプルで説明します。
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • ∠Aは「56.3」です。
  • 辺zは「18.02775638」です。
  • 「辺y」及び「辺x」を求める。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数角度 56.3 ∠A
    RADIANS =RADIANS(B1) ラジアン
    引数正接 18.02775638 正接z
    Sine =B3*SIN(B2) 正弦y
    Cosine =B3*COS(B2) 余弦x
    2
    3
    4
    5
    6      
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • ∠Aは「56.3」です。
  • 辺xは「10.0026001668331」です。
  • 「辺y」及び「辺z」を求める。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数角度 56.3 ∠A
    RADIANS =RADIANS(B1) ラジアン
    引数余弦 10.0026001668331 余弦x
    Cosine =B3/COS(B2) 正接z
    Tangent =B3*TAN(B2) 正弦y
    2
    3
    4
    5
    6      
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • ∠Aは「56.3」です。
  • 辺zは「14.9982662331051」です。
  • 「辺x」及び「辺z」を求める。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数角度 56.3 ∠A
    RADIANS =RADIANS(B1) ラジアン
    引数正弦 14.9982662331051 正弦y
    Sine =B3/SIN(B2) 正接z
    Tangent =B3/TAN(B2) 余弦x
    2
    3
    4
    5
    6      

角度をアークで求めます

  • いよいよアークです。
  • 「三角関数を使う」という条件です。※算出方法は他にもあります。
  • エクセルでのサンプルです。
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • 辺yは「14.9982662331051」です。
  • 辺zは「18.02775638」です。
  • 「∠A角度」及び「辺x」を求める。
  • ヒントは前項のピタゴラスの定理:2章-2D編-図解での
  • 縦位置(Y座標・正弦)÷斜位置(Z座標・正接)=Sine(サイン・正弦)。
  • 縦位置(Y座標・正弦)と斜位置(Z座標・正接)が判っているのでARCSine(サイン・正弦)を使う。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数正弦 14.9982662331051 正弦y
    引数正接 18.02775638 正接z
    ARCSine =ASIN(B1/B2) ラジアン
    DEGREES =DEGREES(B3) ディグリー
    Cosine =B2*COS(RADIANS(B4)) 余弦x
    Tangent =B1/TAN(RADIANS(B4)) 余弦x
    2
    3
    4
    5
    6
    7      
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • 辺xは「10.0026001668331」です。
  • 辺zは「18.02775638」です。
  • 「∠A角度」及び「辺y」を求める。
  • ヒントは前項のピタゴラスの定理:2章-2D編-図解での
  • 横位置(X座標・余弦)÷斜位置(Z座標・正接)=Cosine(コサイン・余弦)。
  • 横位置(X座標・余弦)と斜位置(Z座標・正接)が判っているのでARCCosine(コサイン・余弦)を使う
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数余弦 10.0026001668331 余弦x
    引数正接 18.02775638 正接z
    ARCCosine =ACOS(B1/B2) ラジアン
    DEGREES =DEGREES(B3) ディグリー
    Tangent =B1*TAN(RADIANS(B4)) 正弦y
    Sine =B2*SIN(RADIANS(B4)) 正弦y
    2
    3
    4
    5
    6
    7      
  • 赤い部分が判っているところで青い部分が判らない箇所です。
  • 黄色は∟(直角90度)です。
  • 辺xは「10.0026001668331」です。
  • 辺yは「14.9982662331051」です。
  • 「∠A角度」及び「辺z」を求める。
  • ヒントは前項のピタゴラスの定理:2章-2D編-図解での
  • 縦位置(Y座標・正弦)÷横位置(X座標・余弦)=Tangent(タンジェント・正接)。
  • 縦位置(Y座標・正弦)と横位置(X座標・余弦)が判っているのでARCTangent(タンジェント・正接)を使う
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。
  •   A B C
    1
    引数余弦 10.0026001668331 余弦x
    引数正弦 14.9982662331051 正弦y
    ARCTangent =ATAN(B2/B1) ラジアン
    DEGREES =DEGREES(B3) ディグリー
    Sine =B2/SIN(RADIANS(B4)) 正接z
    Cosine =B1/COS(RADIANS(B4)) 正接z
    2
    3
    4
    5
    6
    7      
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:Play

ピタゴラスの定理:2章-2D編

ピタゴラス
  1. 三角関数
    1. 正弦・余弦・正接とは
    2. 正接以外の正弦・余弦は変わる?
    3. 三角関数のイメージ
    4. もっと簡単に!
    5. エクセルで確認してみる
    6. 今度は長さを求めます
    7. エクセルで長さを求める
    8. 要するに
    9. あれっ!ハガキのサイズと一致した。
    10. もう一つの"三角関数"アーク

三角関数

  • 三角関数は日常様々なところで使われています。地図・海図・軌跡・電波・建設など、特にPCでお仕事をされている方(CAD・製図・図形・音・ゲーム・グラフィック・プログラミング)には必須関数ともいえます。
  • 英名 Trigonometric Function
  • 総称して三角関数とは
  • 1.ある線の長さを1とします。
  • 2.その線をある角度の方向に描いた場合
  • 3.線の先端がどの位置に置かれるのかを算出するものです。
  • ある角度(図の青色)をTheta(シータθ)と言います。
  • 正弦・余弦・正接とは

  • 線の先端の縦位置(Y座標)をSine(サイン・正弦)。
  • 線の先端の横位置(X座標)をCosine(コサイン・余弦)。
  • 線の先端の斜位置(Z座標)をTangent(タンジェント・正接)。
  • 正確に定義で言えば
    • 縦位置(Y座標・正弦)÷斜位置(Z座標・正接)=Sine(サイン・正弦)。
    • 横位置(X座標・余弦)÷斜位置(Z座標・正接)=Cosine(コサイン・余弦)。
    • 縦位置(Y座標・正弦)÷横位置(X座標・余弦)=Tangent(タンジェント・正接)。
  • Tangent(タンジェント/正接)は Sine÷Cosineです。
  • 当然、Theta(図の青色[シータθ])が0度の場合は線(上左図の赤線)は真右です。
  • Theta(図の青色[シータθ])が増すと反時計回り(正方向)に上昇します。
  • Theta(図の青色[シータθ])が90度ですと線(上左図の赤線)は真上になります。
  • Sine(サイン/正弦)はエクセルですと「=SIN(値)」
  • Cosine(コサイン/余弦)はエクセルですと「=COS(値)」
  • ピタゴラスの定理
    • 幾何学的(きかがく)に直角三角形の斜辺の長さを c とし、他の辺の長さを a, b とした場合
    • a²+b²=c²
    • という関係が成立する。
  • ピタゴラスの定理から三角関数のSineCosine
  • sin2θ + cos2θ = 1
    1=SQRT(SIN(180)^2+COS(180)^2)
    1=SQRT(Sine(Theta)^2+Cosine(Theta)^2)
  • 前述「ピタゴラスの定理:1章-平方根とラジアン-図解」のハガキの=SQRT( X^2 + Y^2 )と同じ意味です。

正接以外の正弦・余弦は変わる?

  • 参考程度のこの項は読まなくてもOKです。
1.⇒

  • 現在の正弦・余弦
  • 赤を∠角
  • 青を∠余角とする
2. ⇒
 裏返す
  • そのまま
  • 裏返す
  • それを
3. ⇒
 傾きを変える
  • 直角が右下になるように
  • 傾きを変える
 4. ⇒
 
  • すると
  • ∠角と∠余角が逆転し
  • 余り角に対しての
  • 正弦・余弦の関係も逆転する。
  • 正接(斜線)は変わらない。
  • 三角形の内角の和は180度。
  • 黄色の角は直角90度。
  • 直角以外の角2つの和は90度。
  • よって2つの何れかの角度が判れば
  • もう一方の角度は判る。

三角関数のイメージ

三角関数のイメージ
図①
 三角関数のイメージ拡大
 図②(①の拡大)
 三角関数のイメージ
 図③
  • 図①を拡大したものが図②で青塗りが「シータθ」
  • 黄塗りは直角90°になります。
  • 横軸がSine(X座標)
  • 縦軸がCosine(Y座標)
  • 図③はオレンジ線が「0」として
  • 青線がPI(つまり3.14159265358979)
  • 緑線がPIの半分でPI()÷2
  • 赤線がPIの1.5倍でPI()×1.5

もっと簡単に!

 >>
 
 >>
 
 >>
 
  • RA角は直角(直角三角形)。
  • 三角形の内角の和は180度。
  • θの角度の大きさが定まれば、3辺の比も決まる。
  • つまり辺同士の比が判ります。
  • θは角度又はラジアン値です。
  • A-C間(横)をx
  • B-C間(縦)をy
  • A-B間(斜)をzとします。
  • xyzの3つ比の全ての組み合わせは、
  • 以下になります。
6つ三角比の組み合わせ
基本の3つ
1 正弦せいげん サイン sineθ = y / z /
2 余弦よげん コサイン cosineθ = x / z /
3 正接せいせつ タンジェント tangentθ = y / x / = 縦/斜 / 横/斜
単に逆数なので無視しても良い(//)
4 余割よかつ コセカント cosecantθ = z / y / = 1 / 縦/斜
5 正割せいかつ セカント secantθ = z / x / = 1 / 横/斜
6 余接よせつ コタンジェント cotangentθ = x / y / = 1 / 縦/横

エクセルで確認してみる

  •   A B C
    1 角度 56.3 説明
    2 RADIANS 0.982620369 ラジアン値を求める
    3 Cosine(x座標) 0.554844427  
    4 Sine(y座標) 0.831954122  
    5 Tangent(z座標) 1.499436745 (=y / x)
  • ラジアンはピタゴラスの定理:1章-平方根とラジアン-図解で説明済み。
  • 上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
  • 下記はその数式を写しました。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください
  •   A B C
    1
    角度 56.3 説明
    RADIANS =RADIANS(B1) ラジアン値を求める
    Cosine(x座標) =COS(B2)  
    Sine(y座標) =SIN(B2)  
    Tangent(z座標) =TAN(B2) (=y / x)
    2
    3
    4
    5
  • セル「B1」の値(現在は「56.3」が入力されています)を変えてみて下さい。
  • この算出数値は全てです。

今度は長さを求めます

  • 図は上と同じです。
  • 黄色の角度は直角(直角三角形)です。
  • 先ほどのA-B間(斜辺つまりz)の長さは「1」と仮定してありましたから(×1)は省略されてます。
  • シータθ(赤の塗りつぶし)角度とA-B間(斜辺つまりz)の長さが判ればA-C間(底辺x)の長さやB-C間(高さy)の長さが判ります。

エクセルで長さを求める

  •   A B C
    1 角度 56.3 説明
    2 長さ(z) 18.02775638  
    3 Cosine(x座標) 10.00260017 ※1
    4 Sine(y座標) 14.99826623 ※2
    5 Tangent(z座標) 27.03148034 (=y / x)
  • ラジアン値は数式に組み込まれてます。
  • 上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
  • 下記はその数式を写しました。
  • 黄色の部分を選択するか ボタンを押してエクセルのセル「A1」に「貼り付け」てみてください
  •   A B C
    1
    角度 56.3 説明
    長さ(z) 18.02775638  
    Cosine(x座標) =COS(RADIANS(B1))*B2  
    Sine(y座標) =SIN(RADIANS(B1))*B2  
    Tangent(z座標) =TAN(RADIANS(B1))*B2 (=y / x)
    2
    3
    4
    5
  • セル「B1」の値(現在は「56.3」が入力されています)を変えてみて下さい。
  • セル「B2」の値(現在は「18.02775638」が入力されています)を変えてみて下さい。
  • この算出数値は全て長さです。

要するに

引数に角度指定 斜辺」を指定した場合 斜辺」を指定しない場合
サイン 高さ 高さ÷斜辺(比)
コサイン 底辺 底辺÷斜辺(比)
タンジェント 高さ÷底辺 高さ÷底辺(比)

あれっ!ハガキのサイズと一致した。

  • ※1※2の数値を見てください。「10.00260017」と「14.99826623」!
  • そうです。ピタゴラスの定理:1章-平方根とラジアン-図解の冒頭のハガキのサイズと限りなく近い数値になりましたね。
  • 先ほども申しましたがTangent(タンジェント/正接)は Sine÷Cosineです。
  • これで三角関数、”三兄弟”サイン・コサイン・タンジェントは判りました。
  • 「実際に角辺の長さを計る」応用は後に説明します。

もう一つの"三角関数"アーク

  • サイン・コサイン・タンジェントの他にそれらの文字の頭に「アーク」が付加する、
  • アークサイン・アークコサイン・アークタンジェントがあります。
  • その他にも立体3Dバージョンもあります。
  • これらは次の章「ピタゴラスの定理:3章-アーク編」で説明いたします。
  • はてなブックマークに追加

 

2016年10月01日[VBサンプルコード]:Play

ピタゴラスの定理:1章-平方根とラジアン

ピタゴラス
  1. 平方根
    1. 平方根の概要と必要性
    2. はがき(葉書)を例に!
    3. 求め方
    4. 平方根の求め方。「9」を例にしてみます。
    5. 大きな数値の場合は?
    6. 計算は大変ですよね!そこで関数を使います。
    7. ひとよひとよにひとみごろ(一夜一夜に人見頃)
    8. 平方根のイメージ
  2. ラジアン角
    1. キーワードは円周率
    2. 円周率はPIで示す。
    3. ラジアンRADと度DEGの関係

平方根

平方根の概要と必要性

  • 三角関数を理解するためには先ず「平方根」を理解して下さい。
  • 関数「平方根」は正の平方根(へいほうこん)を返します。
  • 別名では二乗根(にじょうこん)、自乗根(じじょうこん)。
  • 英名では「Square Root」(スクエア)
  • VBでは[sqr()]、エクセルで求めるならSQRT。
  • 記号は√で表します。
  • 平方根の記号 √a 読みはルートエー(a)、√は根号

はがき(葉書)を例に!

どのご家庭にも必ずある官製はがき、これを例にして平方根を説明します。
ハガキは横幅が約10cm、高さが15cmあります。
ハガキの赤線の長さを求めるにはどうすればよいでしょう?
答えは「18.02775638」cmになります。

求め方

  • 横幅をX座標、高さをY座標をします。
  • X^2剰 (10cm×10cm) = 100
  • Y^2剰 (15cm×15cm) = 225
  • これを足し算します。100 + 225 = 325
  • エクセルならシート関数[=SQRT(325)]で答えがでます。
  • この関数「SQRT」が平方根です。
  • 平方根はある数字が2剰と一致する数値です。
  • 例えばある数字が「4」であれば「4 = 2 × 2」つまり、2^2剰です。
  • 「9」であれば3、「16」であれば4です。この「2」「3」「4」の数値が平方根です。

平方根の求め方。「9」を例にしてみます。

回数 個々の数値
1 9 - 1 = 8 9 - 1 = 8
2 8 - 3 = 5 8 - 3 = 5
3 5 - 5 = 0 5 - 5 = 0
  • 黄色の部分は1から始まる増加していく奇数です。
  • 基になる「9」から最初の奇数「1」を引きます。
  • すると答えは「8」になります。
  • この「8」が次の基になる数値です。
  • 今度は「8」から次の奇数「3」を引きます。
  • これを答えが「0」になるまで続けます。
  • 回数「3」回になります。これが平方根です。
  • √9と表します。

大きな数値の場合は?

回数 個々の数値
1 7 - 1 = 6 7-1=6
2 6 - 3 = 3 6-3=3
1 384 - 41 = 343 384-41=343
2 343 - 43 = 300 343-43=300
3 300 - 45 = 255 300-45=255
4 255 - 47 = 208 255-47=208
5 208 - 49 = 159 208-49=159
6 159 - 51 = 108 159-51=108
7 108 - 53 = 55 108-53=55
8 55 - 55 = 0 55-55=0
  • 例えば「784」なような場合には、
  • 数値を分けて考えます。
  • 「784」の場合だと「7」と「84」に分けます。
  • 「7」から始めます。
  • 2回で引けなくなりました。
  • 余りは「3」、それと「84」を結合した数値にします。
  • 384」を基点として回数は新たに数えます。
  • 次に黄色の引く数値が変わります。
  • 最後の黄色の数値は3でしたから今度はその数値に3の次の数値の4(3+1=4)と1から始まる奇数を結合した数値「43」から始めます。
  • 「8」回で終わりました。
  • 最初の「7」の方は「2」回でしたから「28」になります。
  • この様に筆算で求める方法を開平法と言います。

計算は大変ですよね!そこで関数を使います。

  • ハガキの
  • X~2剰 (10cm×10cm) = 100
  • Y~2剰 (15cm×15cm) = 225
  • 二つを足すと100 + 225 = 325になります。
  • 関数を使う場合は式を入れます
  • =SQRT( X^2 + Y^2 )
  • スクエアと読みます。
  • 答えは「18.02775638」cmになります。

ひとよひとよにひとみごろ(一夜一夜に人見頃)

  • 「いい国つくろう鎌倉幕府(現在は1185年説もあり)」は歴史年号ですが語呂合わせ数学バージョンにもあります。
  • 1~10の整数に限って言えば平方数の1と4と9以外の数値の平方根は整数にはなりません。
  • 1と4と9を除く数値の平方根は円周率の「3.14・・・・」のような終わりのない数値になります(無理数という)。
√1 1 整数
√2 1.414213562 一夜一夜に人見頃(ひとよひとよにひとみごろ)
√3 1.732050808 人並みに奢れや女子(ひとなみにおごれやおなご)
√4 2 整数
√5 2.236067977 富士山麓鸚鵡鳴く(ふじさんろくおーむなく)
√6 2.449489743 ツヨシ串焼くな(つよしくしやくな)
√7 2.645751311 菜に虫いない(なにむしいない)
√8 2.828427125 ニヤニヤ呼ぶな(にやにやよぶな)
√9 3 整数
√10 3.16227766 父さん一郎兄さん(とうさんいちろーにーさん)
<

平方根のイメージ

平方根のイメージ 長さ=斜辺

ラジアン角

ラジアンとディグリー(角度)を覚えないと三角関数は判りません。

キーワードは円周率

  • ラジアンの値は近似値
  • 角度を数値にしたものです。
  • PI()=3.14159265358979 つまり円周率です。
  • エクセルでは「=PI()」で求められます。

円周率はPIで示す。

円周率は英語でPi
PI()=3.14159265358979
PI()*2= 6.283185307
PI()= 3.141592654
PI()/2= 1.570796327
PI()/4= 0.785398163
PI()/8= 0.392699082

ラジアンRADと度DEGの関係

PI()=3.14159265358979(ラジアン)
数式(参照元[ラジアン]) 答え(ディグリー) (ラジアン)答え 数式(参照元[ディグリー])
=DEGREES(PI()*2) 360 6.283185307 =RADIANS(360)
=DEGREES(PI()) 180 3.141592654 =RADIANS(180)
=DEGREES(PI()/2) * 90 1.570796327 * =RADIANS(90)
=DEGREES(PI()/4) 45 0.785398163 =RADIANS(45)
=DEGREES(PI()/8) 22.5 0.392699082 =RADIANS(22.5)
  • ラジアンで表された角度をに変更します。
    • DEGREES(角度) / ディグリー
    • 使用例 DEGREES(PI()) = 180
    • 上の表* 「1.570796327」ディグリー = 90度になります。
    • 関数使用ではDEGREES(1.570796327) = 90
  • 単位で表された角度をラジアンに変換した結果を返します。
    • RADIANS(角度) / ラジアン
    • 使用例 RADIANS(270) = 4.712389 (3π/2 ラジアン)
    • 上の表* 「90」ラジアン = 1.570796327 になります。
    • 関数使用ではRADIANS(90) = 1.570796327
  • はてなブックマークに追加
2016年10月01日[VBサンプルコード]:Play

Adobe Photoshop Elements 金ゴールドメタル文字(グラデーション)を作成

Adobe Photoshopの簡易版ElementsはPhotoshopの機能を限定したものです。

  • Adobe Photoshopは高機能ですがAdobe Photoshop Elementsの方もなかなかのもの
  • 今回は簡単な方法で金ゴールド文字を作成してみます。
  • 注意:方法は他にもありますし、もっと鮮やかに金色文字は作成出来ます。

 

ファイル → 新規
図のようにし、値は適当で良い
するとこんな透明なウィンドウが出来ます。
イメージ → サイズ変更 →  カンバスサイズ
この例では幅・高さ共に約2倍にしました。
広がりました。
 
  • 自動選択ツールオプション
  • 横書き文字ツール
  • その上で右クリックで縦横変更可能
書体や文字の大きさ・色はここで変更可能
ここでは色は何色でも構いません。
自動選択ツール
該当ウィンドウの上でクリック
※注意:この方法は簡単な方法で各文字内が潰れてしまいます。
潰さないようにするには1文字づつキーボードの「Shift」を押したまま選択する必要があります。
選択範囲 → 選択範囲を反転
※注意:この方法は簡単な方法で各文字内が潰れてしまいます。
潰さないようにするには1文字づつキーボードの「Shift」を押したまま選択する必要があります。
すると文字だけが選択されます。
※注意:この方法は簡単な方法で各文字内が潰れてしまいます。
潰さないようにするには1文字づつキーボードの「Shift」を押したまま選択する必要があります。
レイヤー →  新規  → レイヤー
レイヤーを追加されます
追加したレイアーが選択されているか確認します。
グラデーションツールを選択
 
上部のドロップダウン
表示されたパレット内のドロップダウン
メタルを選択
真鍮を選択
 
該当ウィンドウ上でマウスの左を押した状態で縦に線を引く
縦・横・斜め等、自由に引けます。
選択された文字だけに選んだグラデーションがかかります。
レイヤースタイル →  ベベル
今回はシンプル(エンボス)を選択
他のものもいろいろ試して、好みのものを選択して下さい。
同じくレイヤースタイル
ドロップシャドウ
低を選択
他でも選択可能。
レイヤー →  表示部分を結合
矩形選択ツール
文字だけ選択(囲む)
編集  → コピー
ファイル → 新規
編集 →  ペースト
完成
※注意:この方法は簡単な方法で各文字内が潰れてしまいます。
潰さないようにするには自動選択ツールの時点で1文字づつキーボードの「Shift」を押したまま選択する必要があります。
  • はてなブックマークに追加

 

2001年06月30日[VBサンプルコード]:ソフト

Adobe Photoshop Elements 球体立体3D画像を作成

Adobe Photoshopの簡易版ElementsはPhotoshopの機能を限定したものです。

お好きな画像を用意します。ここでは国旗を作成例として作成します。
※画像はネット上のものでも構いません。(著作権に注意)
球体にするのでまず正方形に変形します。
イメージ→サイズ変更→画像解像度
 
縦横比を固定のチェックを外す。
 
幅125×高さ83を小さい方のサイズに統一する。
 
球面にする。
フィルタ→変形→球面を実行
 
OKボタンを押す
 
円形に切り取ります。
ツールボックス内の該当ツールを右クリックして矩形選択ツール→楕円形選択ツールに切り替えます。
※ツールボックスが表示されていない場合はメニュー→ウィンドウ→メニュー→ツールボックスを表示
 
楕円形選択ツールに変更後、上部のスタイル→標準→固定に変更
 
先ほどのサイズの小さい方が83ピクセルだったので正方形なので幅、高さともに83ピクセルに統一する。
 
画像の上でドラッグし丁度中心になるように合わせ、編集→コピーする。ファイル→新規作成→OK→編集→ペースト
 
レイヤースタイルにガラスボタンを設定
 
一覧の下の方にガラス(半透明)があるので選択する。
 
 
メニュー→レイヤー→レイヤースタイル→スタイル設定
 
照明角度や光彩(内側)サイズ及びベベルサイズを任意で設定。傾斜方向は上へで設定。
照明角度は90で真上からとなる。
※場合によっては包括光源を使用チェックを外す
 
※ここで注意:複数画像処理する場合
メニュー→レイヤー→レイヤースタイル→スタイル設定→レイヤースタイルをコピー
「レイヤースタイルをペースト」を使う
レイヤー画像を統合
一旦画像を統合する。レイヤー→画像を統合
 
見た目は変わりませんが周りが着色されます
周りを脱色する。
ツールボックス内→マジック消しゴムツールを選択
 
四隅をクリックし透明にする。
 
イメージ→サイズ変更→画像解像度で縦横比を固定のチェックを入れ任意の大きさにする(画像を綺麗に保つためには元の大きさよりは大きくならないように)。ここでは83→39に変更。
 
カンバスサイズを少し広げる。
イメージ→サイズ変更→カンバスサイズ
 
アンカーは中心のままで幅と高さを同じ大きさで広げる。ここでは1.73に設定した。
 
ベベルをを適用
レイヤースタイル→ベベルを選択
 
上部にあるシンプル(外側)を選択
 
レイヤーススタイル設定
メニュー→レイヤー→レイヤースタイル→スタイル設定
 
照明角度及びベベルサイズを任意で設定。傾斜方向は上へで設定。
照明角度は90で真上からとなる。
※場合によっては包括光源を使用チェックを外す
 
レイヤー画像を統合
レイヤー→画像を統合
出来上がり
指定形式で(JPGなど)保存したい場合、メニュー→ファイル→Web用に保存を使う。
  • はてなブックマークに追加

 

2001年06月30日[VBサンプルコード]:ソフト

文字操作 文字列変換StrConv関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'【構文】

'**********************************
'StrConv(string, conversion, LCID)
'**********************************
'   string
'       必ず指定します。変換する文字列式を指定します。
'
'   Conversion
'       必ず指定します。整数型 (Integer) の値を指定します。
'       実行する変換の種類の値の合計を指定します。
'
'   LCID
'       省略可能です。
'       システムとは異なる国別情報識別子 (LCID) を指定できます。
'       既定値はシステムが使用する LCID です。
'
'【設定値】
'
'定数   vbUpperCase     1
'   文字列を大文字に変換します。
Sub TestvbUpperCase()
    Dim str As String
        str = "12345abcdef"
        MsgBox StrConv(str, vbUpperCase)
        Debug.Print StrConv(str, 1)
        '結果[ 12345ABCDEF ]
End Sub

'
'定数   vbLowerCase     2
'   文字列を小文字に変換します。
Sub TestvbLowerCase()
    Dim str As String
        str = "12345ABCDEF"
        MsgBox StrConv(str, vbLowerCase)
        Debug.Print StrConv(str, 2)
        '結果[ 12345abcdef ]
End Sub

'
'定数   vbProperCase    3
'   文字列の各単語の先頭の文字を大文字に変換します。
Sub TestvbProperCase()
    Dim str As String
        str = "abcdef"
        MsgBox StrConv(str, vbProperCase)
        Debug.Print StrConv(str, 3)
        '結果[ Abcdef ]
End Sub

'
'定数   vbWide          4
'   文字列内の半角文字(1byte)を全角文字(2byte)に変換します。
Sub TestvbWide()
    Dim str As String
        str = "12345abcdefABCDEF"
        MsgBox StrConv(str, vbWide)
        Debug.Print StrConv(str, 4)
        '結果[ 12345abcdefABCDEF ]
End Sub

'
'定数   vbNarrow        8
'   文字列内の全角文字(2byte)を半角文字(1byte)に変換します。
Sub TestvbNarrow()
    Dim str As String
        str = "12345abcdefABCDEF"
        MsgBox StrConv(str, vbNarrow)
        Debug.Print StrConv(str, 8)
        '結果[ 12345abcdefABCDEF ]
End Sub

'
'定数   vbKatakana     16
'   文字列内のひらがなをカタカナに変換します。
Sub TestvbKatakana()
    Dim str As String
        str = "ひらがな"
        MsgBox StrConv(str, vbKatakana)
        Debug.Print StrConv(str, 16)
        '結果[ ヒラガナ ]
End Sub

'
'定数   vbHiragana     32
'   文字列内のカタカナをひらがなに変換します。
Sub TestvbHiragana()
    Dim str As String
        str = "ヒラガナ"
        MsgBox StrConv(str, vbHiragana)
        Debug.Print StrConv(str, 32)
        '結果[ ひらがな ]
End Sub

'
'定数   vbUnicode      64
'   システムの既定のコード ページを使って文字列を Unicode に変換します。
'   Macintosh. では使用できません
Sub TestvbUnicode()
    Dim str As String
        str = "aあ"
        MsgBox LenB(StrConv(str, vbUnicode))
        Debug.Print LenB(StrConv(str, 64))
        '結果[ 8 ]
End Sub

'
'定数   vbFromUnicode 128
'   文字列を Unicode からシステムの既定のコード ページに変換します。
'   Macintosh. では使用できません
Sub TestvbFromUnicode()
    Dim str As String
        str = "aあ"
        MsgBox LenB(StrConv(str, vbFromUnicode))
        Debug.Print LenB(StrConv(str, 128))
        '結果[ 3 ]
End Sub
'
'【メモ】
'
'大文字/小文字を正しく区別する単語セパレータ
'   Null 値                         (Chr$(0))
'   水平タブ                        (Chr$(9))
'   ライン フィード                 (Chr$(10))
'   垂直タブ                        (Chr$(11))
'   フォーム フィード               (Chr$(12))
'   キャリッジ リターン             (Chr$(13))
'   およびスペース (SBCS の場合)    (Chr$(32))
'   ※DBCS のスペースの実際の値は、国によって異なります。
'
'【解説】
'
'ANSI 形式のバイト型配列を文字列に変換する場合
'   StrConv 関数を使用してください。
'Unicode 形式の配列を変換する場合
'   代入式を使用してください。


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列中の数値だけ取り出します

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub NumericalValue()
'*********************************
'文字列中の数値だけ取り出します
'*********************************
Dim strTest(6) As String

strTest(1) = "これは10000個です。"  'ケース①
strTest(2) = "10000個です。"        'ケース②
strTest(3) = "  10000個です。"      'ケース③
strTest(4) = "  10,000個です。"     'ケース④
strTest(5) = "  10000.5個です。"    'ケース⑤
strTest(6) = "10000個です。"   'ケース⑥

MsgBox Val(strTest(1)) 'ケース① 結果[0]
MsgBox Val(strTest(2)) 'ケース② 結果[10000]
MsgBox Val(strTest(3)) 'ケース③ 結果[10000]
MsgBox Val(strTest(4)) 'ケース④ 結果[10]
MsgBox Val(strTest(5)) 'ケース⑤ 結果[10000.5]
MsgBox Val(strTest(6)) 'ケース⑥ 結果[0]

'※Val関数 先頭から検索し数値でない場合は終了します。
'ケース① 先頭文字が数値ではない場合、終了し[0]を返します。
'ケース② 結果[10000]
'ケース③ 空白は無視して検索します。
'ケース④ 桁区切りの[,]は数値とは認識しません。
'ケース⑤ 少数点は認識します。
'ケース⑥ 全角数字は認識しません。
'※文字列内に2つの数値があった場合は最初の数値だけ認識します。

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列表示書式指定文字Format関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

      
'(VB:Help)
'
'@
'1 つの文字またはスペースを表します。
'変換対象 expression の中で @ (アット マーク) に対応する位置に文字が存在する場合は、
'その文字が表示されます。文字がなければスペースが表示されます。@ は、
'引数 format に指定した書式の中に表示書式指定文字の   (感嘆符) がない限り、
'右から左の順に埋められます。
'
'&
'1 つの文字を表します。変換対象 expression の中で & (アンパサンド) に
'対応する位置に文字が存在する場合は、その文字が表示されます。
'文字がなければ何も表示せず、詰められて表示されます。& は、
'引数 format に指定した書式の中に表示書式指定文字の   (感嘆符) がない限り、
'右から左の順に埋められます。
'
'<
'小文字にします。すべての文字は小文字に変換されます。
'
'>
'大文字にします。すべての文字は大文字に変換されます。
'

'文字を右から左ではなく、左から右の順に埋めていくように指定します。
'この文字を指定しない場合は、右から左の順に埋められます。

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列中に2バイト文字(日本語)が含まれているか判定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function CharacterInJapanese(Character As StringAs Boolean
'******************************************
'文字列中に2バイト文字が含まれているか判定
'******************************************
Dim cntLen As Long
Dim cntByt As Long

cntLen = Len(Character)
cntByt = LenB(StrConv(Character, vbFromUnicode))

If (cntLen <> cntByt) Then
    CharacterInJapanese = True
Else
    CharacterInJapanese = False
End If

End Function


Private Sub test()
Dim a As String
Dim b As String
a = "abc"
b = "あいう"
Debug.Print CharacterInJapanese(a)
Debug.Print CharacterInJapanese(b)
'False
'True
a = "abcあいう"
b = "123abc"
Debug.Print CharacterInJapanese(a)
Debug.Print CharacterInJapanese(b)
'True
'False
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 変換に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'ANSI コードの値の文字列への変換 Chr
'文字列の小文字または大文字への変換 Format, LCase, UCase
'日付の連続した番号への変換 DateSerial, DateValue
'十進法表記の他の表記法への変換 Hex, Oct
'数字の文字列への変換.Format , str
'データ型の変換 CBool, CByte, CCur, CDate, CDbl, CDec, CInt, CLng, CSng, CStr, CVar, CVErr, Fix, Int
'日付から日、週、月、年への変換 Day, Month, Weekday, Year
'時間から時、分、秒への変換 Hour, Minute, Second
'文字列の ASCII コードの値への変換 Asc
'文字列の数字への変換 Val
'時間の連続した番号への変換 TimeSerial, TimeValue

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列中の「特殊文字」有無判定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Public Function Fnc文字内禁止有無(strInTEXT As StringAs Boolean
'*******************************************************************************
'文字列中に「,」「"」「'」「Cr」「Lf」有無判定なければTrue
'*******************************************************************************
    Dim IDX As Integer
    Dim strTEXT As String
    Dim strCHAR As String * 1

    Fnc文字内禁止有無 = False
    strTEXT = Trim$(strInTEXT)
    If strTEXT = "" Then
        Fnc文字内禁止有無 = True
        Exit Function
    End If
    For IDX = 1 To Len(strTEXT)
        strCHAR = Mid$(strTEXT, IDX, 1)
        If ((strCHAR = ",") Or (strCHAR = """") Or (strCHAR = "'") Or _
            (strCHAR = ",") Or (strCHAR = Chr(&H818D)) Or (strCHAR = "’") Or _
            (strCHAR = Chr(&H8167)) Or (strCHAR = Chr(&H8168)) Or _
            (strCHAR = vbCr) Or (strCHAR = vbLf)) Then
            Exit Function
        End If
    Next IDX
    Fnc文字内禁止有無 = True
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列の一部を、別の文字列で置換した文字列を返す(Replace関数)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Private Sub SarchWebBrowser_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim a As String

With Me.SarchWebBrowser.Document
a = .documentelement.innerhtml 'まで
End With
Dim MyReplace As String, MyReplace2 As String

MyReplace = Trim(Replace(a, Chr(13), ""))

MyReplace2 = Trim(Replace(MyReplace, Chr(10), ""))
MyReplace = MyReplace2

Dim Hajime As Long, Owari As Long, ShutokuMoji As String, NokoriMoji As String
Dim StrInd As Long, Moji() As String

ReTRY:

Hajime = InStr(1, MyReplace, "<")
Owari = InStr(1, MyReplace, ">")

ShutokuMoji = Mid(MyReplace, 1, Hajime - 1)
If Len(ShutokuMoji) > 0 Then
StrInd = StrInd + 1
ReDim Preserve Moji(StrInd)
Moji(StrInd) = Trim(ShutokuMoji)
'Debug.Print Moji(StrInd)
End If

NokoriMoji = Trim(Mid(MyReplace, Owari + 1, Len(MyReplace)))

If Len(NokoriMoji) > 0 Then
MyReplace = NokoriMoji
GoTo ReTRY:
End If

Dim MyFor As Long
With ThisWorkbook.Worksheets("sheet1")
For MyFor = 1 To StrInd
.Cells(MyFor, 1).Value = Moji(MyFor)
Next MyFor
End With
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字内の空白文字削除及び誤変換文字修正

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Public Function Fnc文字内空白(strInTEXT As StringAs String
'*******************************************************************************
'文字内の空白文字削除及び誤変換文字修正
'*******************************************************************************
    Dim IDX As Integer
    Dim strTEXT As String
    Dim strCHAR As String

    Fnc文字内空白 = ""
    strTEXT = Trim$(strInTEXT)
    IDX = 1
    Do While IDX <= Len(strTEXT)
        strCHAR = Mid(strTEXT, IDX, 1)
        If ((strCHAR <> " ") And (strCHAR <> " ") And (Asc(strCHAR) <> 63)) Then
            Fnc文字内空白 = Fnc文字内空白 & strCHAR
        End If
        IDX = IDX + 1
    Loop
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub 文字変換()
'*******************************************************************************
'文字変換
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

Set sht = ThisWorkbook.Worksheets("Sheet2")

With sht
    b = Fnc最終行(sht)
    For a = 2 To b
        For c = 4 To 4
            d = .Cells(a, c).Value
'            e = UCase(d) 'アルファベット文字列をすべて大文字に変換して返します。
'            e = LCase(d)  'アルファベットの大文字を小文字に変換する。
'            e = StrConv(d, 4)
                        'vbUpperCase  1 大文字に変換
                        'vbLowerCase  2 小文字に変換
                        'vbProperCase 3 各単語の先頭の文字を大文字に変換
                        'vbWide       4 半角文字を全角文字に変換
                        'vbNarrow     8 全角文字を半角文字に変換
                        'vbKatakana  16 ひらがなをカタカナに変換
                        'vbHiragana  32 カタカナをひらがなに変換
            If IsDate(d) = False Then
                
                e = CDate(InputBox(d, "", d))
            Else
                e = CDate(d)
            End If
            .Cells(a, c).Value = e
        Next c
    Next a
End With

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列をUnicodeでバイト数を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function CharacterLenb(ByVal Character As StringAs Long
'*************************************
'文字列をUnicodeでバイト数を取得する
'*************************************
CharacterLenb = LenB(StrConv(Character, vbFromUnicode))
End Function


Private Sub test()
Dim i As String
i = "12あAb亞"
Debug.Print CharacterLenb(i)
Debug.Print LenB(i)

'8
'12
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列の改行コードの箇所を見つけ削除して返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Function 改行コード検索削除(str As StringAs String
'*********************************************
'文字列の改行コードの箇所を見つけ削除して返す
'*********************************************
'※見つからない場合は[原文字列]が返ります
'※引数は文字型
'※辺値も文字型

Dim strEnd As String

strEnd = ""

strEnd = Replace(str, vbCr, "") 'キャリッジ リターン文字
strEnd = Replace(strEnd, vbLf, "") 'ライン フィード文字
strEnd = Replace(strEnd, vbCrLf, "") 'キャリッジ リターン&ライン フィード

改行コード検索削除 = strEnd

'解説
'【vbCr キャリッジ リターン文字】
'   選択行の先頭に戻る又は改行
'【vbLf ライン フィード文字】
'   改行

End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字列操作に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'文字列の比較 StrComp
'文字列の変換 StrConv
'小文字または大文字に変換 Format, LCase, UCase
'文字の繰り返し Space, String
'文字列の長さの取得 Len
'文字列書式の設定 Format
'文字列の配置 LSet, RSet
'文字列の操作 InStr, Left, LTrim, Mid, Right, RTrim, Trim
'文字列の比較条件の設定 Option Compare
'文字コードの操作 Asc, Chr

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定文字数を数える

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Public Function pfnCntMoji(taishou As String, kensaku As StringAs Long
'*******************************************************************************
'指定文字数を数える
'*******************************************************************************
Dim argArray As Variant, cnt As Long
Dim arg As Variant
argArray = Split(taishou, kensaku)
cnt = 0
For Each arg In argArray
  cnt = cnt + 1
Next
pfnCntMoji = cnt - 1
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定ファイル内の指定文字を検索し置換える

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'ファイル内文字置換 ThisWorkbook.Path & "\参照雛形\index.txt", "vbサムネイル", "vbサムネイル"

Sub ファイル内文字置換(対象ファイル$, 検索字$, 置換字$)
'***************************************************
'指定ファイル内の指定文字を検索し置換える
'***************************************************
Dim RetrievalCharacter$, ConversionCharacter$
Dim OriginalFile$, ReproductionFile$
Dim WritingFile As Integer, ReadingFile As Integer
Dim strDAT$, lngCnt&

'パラメータ設定部----------------------------------------------------
'元のファイルフルパスとファイル名
OriginalFile = 対象ファイル
'コピーするファイルとファイル名
ReproductionFile = ThisWorkbook.Path & "\Copy" & Format(Date, "yymmdd") & Format(Time, "hhmmss") & ".txt"
'検索文字
RetrievalCharacter = 検索字
'置換文字
ConversionCharacter = 置換字
'--------------------------------------------------------------------

'エラーが発生した場合次のステートメントから実行継続
On Error Resume Next

'ファイルコピーの実行
FileCopy OriginalFile, ReproductionFile

'エラーが発生した場合
If Err <> 0 Then
    MsgBox "Error" & Err, vbCritical, "Error"
    Exit Sub
End If

'元のファイル削除
Kill OriginalFile

'使用可能なファイル番号取得
WritingFile = FreeFile()
Open ReproductionFile For Input As #WritingFile

'使用可能なファイル番号取得
ReadingFile = FreeFile()
Open OriginalFile For Output As #ReadingFile

'変数初期化
lngCnt = 0
'グローバル変数の初期化
lngNo = 0

Do Until EOF(WritingFile) '最後(全て)
    'ファイル読込
    Line Input #WritingFile, strDAT
    '置換実行(Function)---------------↓対象文字列------↓検索文字------↓置換文字
    lngCnt = lngCnt + FncstrReplace(strDAT, RetrievalCharacter, ConversionCharacter)
    'ファイルに挿入
    Print #ReadingFile, strDAT
Loop

'それぞれのファイルを閉じる
Close #WritingFile
Close #ReadingFile

'最初にコピーしたファイルを削除
Kill ReproductionFile

End Sub


Private Function FncstrReplace&(ByRef 対象文字列$, 検索文字$, 置換文字$)
'***********************************************************************
'指定文字列内の指定文字を検索し置換える
'***********************************************************************

Dim RetrievalResultPosition&, RetrievalBeginningNumber&
Dim ReplacementCharacterNumber&, ConversionCharacterNumber&

    '重複防止検索開始番号初期化
    RetrievalBeginningNumber = 1

    'パラメータ設定
        '置換え側[+ 3]は付ける番号の文字数又は桁数)
        ReplacementCharacterNumber = Len(置換文字) + 3
        '検索側
        ConversionCharacterNumber = Len(検索文字)

    Do
        '対象文字列の検索文字位置取得
        RetrievalResultPosition = InStr(RetrievalBeginningNumber, 対象文字列, 検索文字, vbBinaryCompare)
        '検索文字が[0]の場合
        If RetrievalResultPosition = 0 Then Exit Do

        FncstrReplace = FncstrReplace + 1

        '置換
        対象文字列 = Left$(対象文字列, RetrievalResultPosition - 1) & 置換文字 _
          & Right$(対象文字列, Len(対象文字列) - RetrievalResultPosition - ConversionCharacterNumber + 1)

        '重複検索を防止
        RetrievalBeginningNumber = RetrievalResultPosition + ReplacementCharacterNumber
    Loop

End Function


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定文字のバイト数を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Private Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 拡張子なしのファイル名取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Function FileName() As String
'*****************************
'拡張子なしのファイル名取得
'*****************************

Dim i As Long, nm As String

nm = ThisWorkbook.Name
i = InStrRev(nm, ".")
FileName = Mid(nm, 1, i - 1)

'-------------------------------------------------------------------------
'【構文】
'InstrRev(stringcheck, stringmatch[, start[, compare]])
'文字列から指定文字列を最後から検索し文字位置を返す

'stringcheck    必ず指定    検索先の文字列式を指定。
'stringmatch    必ず指定    検索する文字列式を指定。
'start          省略可能    各検索の開始位置を設定。
'compare        省略可能    文字列比較のモード指定。規定値バイナリモード
'
'引数compareの設定値
'
'定数 値 説明
'vbUseCompareOption    -1 Option Compare ステートメントの設定比較
'vbBinaryCompare        0 バイナリ モード比較
'vbTextCompare          1 テキスト モード比較
'VbDatabaseCompare      2 Microsoft Access の場合
'-------------------------------------------------------------------------
End Function

Private Sub test()
MsgBox FileName
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 改行コード検索

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Function 改行コード検索(str As StringAs Long
'****************************************
'改行コードの箇所を見つけ位置を返す
'****************************************
'※見つからない場合は[0]が返ります
'※引数は文字型
'※辺値はLONG型数値です
'※見つかった先頭位置を返します

Dim lngFound(3) As Long, i As Byte, j As Long

lngFound(1) = InStr(str, vbCr) 'キャリッジ リターン文字
lngFound(2) = InStr(str, vbLf) 'ライン フィード文字
lngFound(3) = InStr(str, vbCrLf) 'キャリッジ リターン&ライン フィード

j = 0

For i = 1 To 3
    If lngFound(i) <> 0 Then
        j = lngFound(i)
    End If
Next i

改行コード検索 = j

End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定した文字を指定した数だけ並べた文字列を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub CharacterContinuation()
'*************************************************
'指定した文字を指定した数だけ並べた文字列を返す
'*************************************************

Debug.Print String(5, "*")
' "*****" を返します。
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定した文字全部を指定した数だけ並べる(繰り返す)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub RepeatLetter()
'*********************************************
'指定した文字を指定した数だけ並べる(繰り返す)
'*********************************************
'String関数
'先頭文字を、指定した文字数だけ並べた文字列を返す文字列処理関数

Dim MyString As String

'文字列の先頭文字を、指定した文字数だけ並べた文字列
MyString = String(5, "*")
' "*****" を返します。
MsgBox MyString
'指定した文字コード (ASCII またはシフト JIS コード) の示す文字
MyString = String(5, 42)
' "*****" を返します。
MsgBox MyString
'文字列の先頭文字を、指定した文字数だけ並べた文字列
MyString = String(10, "ABC")
' "AAAAAAAAAA" を返します。
MsgBox MyString

'文字コード
'ANSI 文字セットなどの文字セット内の各文字を表す番号。

End Sub


Function RepeatAllLetter(Number As Long, strLetter As StringAs String
'*************************************************
'指定した文字全部を指定した数だけ並べる(繰り返す)
'*************************************************
'オリジナル関数
'文字全部を、指定した文字数だけ並べた文字列を返す文字列処理関数

Dim MyString As String, i As Long

MyString = ""
For i = 1 To Number
    MyString = MyString & strLetter
Next i

RepeatAllLetter = MyString

End Function


Private Sub test()
' "ABCABCABCABC" を返します。
    MsgBox RepeatAllLetter(4, "ABC")
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字コードから文字を取得する-文字から文字コードを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub CharacterCodeChr()
'*******************************
'文字コードから文字を取得する
'*******************************

Dim i As Long
Dim str As String

For i = 1 To 20
    str = str & Chr(i) & " "
Next

Debug.Print str
'       
'   
'       

'Chr 関数
'指定した文字コードに対応する文字を示す文字列型の値を返します。

End Sub


Sub CharacterCodeChrAsc()
'*******************************
'文字から文字コードを取得する
'*******************************

Dim i As Long
Dim str As String

For i = 1 To 20
    str = str & Chr(Asc("Ⅰ") + i - 1)
Next i

Debug.Print str
'ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩ・㍉㌔㌢㍍㌘㌧㌃㌶㍑

'Asc 関数
'整数型の値を返します。
'指定した文字列内にある先頭の文字の文字コードを返す変換関数です。

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定文字列から特定文字を最初から検索・最後から検索InStr関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

InStr 関数

バリアント型 (内部処理形式 Long の Variant) の値を返します。ある文字列 (string1) の中から指定した文字列 (string2) を検索し、最初に見つかった文字位置 (先頭からその位置までの文字数) を返す文字列処理関数です。

  • 構文

  • InStr([start, ]string1, string2[, compare])
  • Instr 関数の構文は、次の引数から構成されます。
  • 指定項目 内容

  • start
    省略可能です。検索の開始位置を表す数式を指定します。省略すると、先頭の文字から検索されます。引数 start に Null 値が含まれている場合、エラーが発生します。引数 compare を指定した場合は、start も指定する必要があります。
  • string1
    必ず指定します。検索対象となる文字列式を指定します。
  • string2
    必ず指定します。引数 string1 内で検索する文字列式を指定します。
  • compare
    省略可能です。文字列比較の比較モードを指定する番号を設定します。引数 compare が Null 値の場合は、エラーが発生します。引数 compare を指定した場合は、引数 start も指定する必要があります。引数 compare を省略すると、Option Compare ステートメントの設定に応じて、比較モードが決まります。ローカル固有の比較ルールを使用するには、有効なLCID (LocaleID) を指定します。
  • 設定値

  • 引数 compare

    の設定値は次のとおりです。
  • 定数 値 説明
  • 定数 説明
    vbUseCompareOption -1 OptionCompareステートメントの設定を使用して比較を行います。
    vbBinaryCompare 0 バイナリモードの比較を行います。
    vbTextCompare 1 テキストモードの比較を行います。
    vbDatabaseCompare 2 MicrosoftAccessの場合のみ有効。データベースに格納されている設定に基づいて比較を行います。
  • 戻り値

  • 内容
    string1 が長さ 0 の文字列 (") のとき 0
    string1 が Null 値のとき Null 値
    string2 が長さ 0 の文字列 (") のとき start
    string2 が Null 値のとき Null 値
    string2 が見つからないとき 0
    string2 が string1 内で見つかったとき 見つかった文字列の位置
    start の値が string1 の文字数を超えるとき 0
  • 解説

  • 文字列をバイト データとして扱う場合は、InStrB 関数を使用します。InStrB 関数は検索結果をバイト位置 (先頭からその位置までのバイト数) で返します。

    InStr 関数の使用例

  • 次の例は、InStr 関数を使って、ある文字列の中から指定した文字列を検索し、最初に見つかった位置を返します。
Option Explicit

Dim SearchString, SearchChar, MyPos
SearchString = "XXpXXpXXPXXP"           ' 検索対象の文字列を定義します。
SearchChar = "P"                        ' "P" を検索します。

' 文字単位の比較を位置 4 から開始すると、6 が返されます。
MyPos = InStr(4, SearchString, SearchChar, 1)

' ビット単位の比較を位置 1 から開始すると、9 が返されます。
MyPos = InStr(1, SearchString, SearchChar, 0)

' 既定のビット単位の比較を行います(最後の引数を省略した場合)。
MyPos = InStr(SearchString, SearchChar)    ' 9 を返します。

MyPos = InStr(1, SearchString, "W")        ' 0 を返します。

'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │A/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘



InStrRev 関数

ある文字列 (string1) の中から指定された文字列 (string2) を最後の文字位置から検索を開始し、最初に見つかった文字位置 (先頭からその位置までの文字数) を返す文字列処理関数です。

  • 構文

  • InstrRev(stringcheck, stringmatch[, start[, compare]])
  • InstrRev 関数の構文は、次の名前付き引数から構成されます。
  • 指定項目 説明

  • stringcheck
    必ず指定します。検索先の文字列式を指定します。
  • stringmatch
    必ず指定します。検索する文字列式を指定します。
  • start
    省略可能です。各検索の開始位置を設定する数式を指定します。引数 start を省略すると -1 が使用され、最後の文字位置から検索を開始します。引数 start に Null 値が含まれると、エラーになります。
  • compare
    省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を指定します。引数 compare を省略すると、バイナリ モードで比較が行われます。設定する値については、次の「設定値」を参照してください。
  • 設定値

  • 引数 compare の設定値は次のとおりです。
  • 定数 値 説明

  • 定数 説明
    vbUseCompareOption -1 OptionCompareステートメントの設定を使用して比較を行います。
    vbBinaryCompare 0 バイナリモードの比較を行います。
    vbTextCompare 1 テキストモードの比較を行います。
    vbDatabaseCompare 2 MicrosoftAccessの場合のみ有効。データベースに格納されている設定に基づいて比較を行います。
  • 戻り値

  • InStrRev 関数の戻り値は次のとおりです。
  • 内容
    string1 が長さ 0 の文字列 (") のとき 0
    string1 が Null 値のとき Null 値
    string2 が長さ 0 の文字列 (") のとき start
    string2 が Null 値のとき Null 値
    string2 が見つからないとき 0
    string2 が string1 内で見つかったとき 見つかった文字列の位置
    start の値が string1 の文字数を超えるとき 0
  • 解説

  • InstrRev関数の構文は、Instr関数の構文とは異なります。

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 指定文字列を最後から検索した文字を2分割する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'最後から検索

Function FirstStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を2分割する
'*********************************************
'返値:最初(左)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchLast = FirstStr
Exit Function
ErrEnd:
FirstStrSearchLast = ""
End Function


Function LastStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を2分割する
'*********************************************
'返値:最後(右)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchLast = LastStr
Exit Function
ErrEnd:
LastStrSearchLast = ""
End Function


'最初から検索

Function FirstStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を2分割する
'*********************************************
'返値:最初(左)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchFirst = FirstStr
Exit Function
ErrEnd:
FirstStrSearchFirst = ""
End Function


Function LastStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を2分割する
'*********************************************
'返値:最後(右)の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchFirst = LastStr
Exit Function
ErrEnd:
LastStrSearchFirst = ""
End Function


Private Sub test()
Dim strTest As String, SearChTest As String
    strTest = "本日 は 晴天 なり"
    SearChTest = " "
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日 は 晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は 晴天 なり
    strTest = "本日-は-晴天-なり"
    SearChTest = "-"
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日 は 晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は 晴天 なり
End Sub


'参考

Function GetFileName(strPath As String)
'*********************************
'パス文字列からファイル名だけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetFileName = Fl
Exit Function
ErrEnd:
GetFileName = ""
End Function


Function GetPathName(strPath As String)
'*********************************
'パス文字列からパスだけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetPathName = Pth
Exit Function
ErrEnd:
GetPathName = ""
End Function


Private Sub testg()
Dim strTest As String
strTest = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Debug.Print GetFileName(strTest)
    Debug.Print GetPathName(strTest)
End Sub


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字空白削除と禁止有無

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub 文字空白削除と禁止有無()
'*******************************************************************************
'文字空白削除と禁止有無
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

Set sht = ThisWorkbook.Worksheets("Sheet2")

With sht
    b = Fnc最終行(sht)
    For a = 1 To b
        For c = 1 To 16
            d = .Cells(a, c).Value
            e = Fnc文字内空白(d)
            .Cells(a, c).Value = e
            If Fnc文字内禁止有無(e) = False Then
            MsgBox e, vbCritical, "ERRR "
            End If
        Next c
    Next a
End With

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字を全角から半角にする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'【構文】

'**********************************
'StrConv(string, conversion, LCID)
'**********************************
'   string
'       必ず指定します。変換する文字列式を指定します。
'
'   Conversion
'       必ず指定します。整数型 (Integer) の値を指定します。
'       実行する変換の種類の値の合計を指定します。
'
'   LCID
'       省略可能です。
'       システムとは異なる国別情報識別子 (LCID) を指定できます。
'       既定値はシステムが使用する LCID です。
'
'【設定値】
'
'定数   vbUpperCase     1
'   文字列を大文字に変換します。
Sub TestvbUpperCase()
    Dim str As String
        str = "12345abcdef"
        MsgBox StrConv(str, vbUpperCase)
        Debug.Print StrConv(str, 1)
        '結果[ 12345ABCDEF ]
End Sub

'
'定数   vbLowerCase     2
'   文字列を小文字に変換します。
Sub TestvbLowerCase()
    Dim str As String
        str = "12345ABCDEF"
        MsgBox StrConv(str, vbLowerCase)
        Debug.Print StrConv(str, 2)
        '結果[ 12345abcdef ]
End Sub

'
'定数   vbProperCase    3
'   文字列の各単語の先頭の文字を大文字に変換します。
Sub TestvbProperCase()
    Dim str As String
        str = "abcdef"
        MsgBox StrConv(str, vbProperCase)
        Debug.Print StrConv(str, 3)
        '結果[ Abcdef ]
End Sub

'
'定数   vbWide          4
'   文字列内の半角文字(1byte)を全角文字(2byte)に変換します。
Sub TestvbWide()
    Dim str As String
        str = "12345abcdefABCDEF"
        MsgBox StrConv(str, vbWide)
        Debug.Print StrConv(str, 4)
        '結果[ 12345abcdefABCDEF ]
End Sub

'
'定数   vbNarrow        8
'   文字列内の全角文字(2byte)を半角文字(1byte)に変換します。
Sub TestvbNarrow()
    Dim str As String
        str = "12345abcdefABCDEF"
        MsgBox StrConv(str, vbNarrow)
        Debug.Print StrConv(str, 8)
        '結果[ 12345abcdefABCDEF ]
End Sub

'
'定数   vbKatakana     16
'   文字列内のひらがなをカタカナに変換します。
Sub TestvbKatakana()
    Dim str As String
        str = "ひらがな"
        MsgBox StrConv(str, vbKatakana)
        Debug.Print StrConv(str, 16)
        '結果[ ヒラガナ ]
End Sub

'
'定数   vbHiragana     32
'   文字列内のカタカナをひらがなに変換します。
Sub TestvbHiragana()
    Dim str As String
        str = "ヒラガナ"
        MsgBox StrConv(str, vbHiragana)
        Debug.Print StrConv(str, 32)
        '結果[ ひらがな ]
End Sub

'
'定数   vbUnicode      64
'   システムの既定のコード ページを使って文字列を Unicode に変換します。
'   Macintosh. では使用できません
Sub TestvbUnicode()
    Dim str As String
        str = "aあ"
        MsgBox LenB(StrConv(str, vbUnicode))
        Debug.Print LenB(StrConv(str, 64))
        '結果[ 8 ]
End Sub

'
'定数   vbFromUnicode 128
'   文字列を Unicode からシステムの既定のコード ページに変換します。
'   Macintosh. では使用できません
Sub TestvbFromUnicode()
    Dim str As String
        str = "aあ"
        MsgBox LenB(StrConv(str, vbFromUnicode))
        Debug.Print LenB(StrConv(str, 128))
        '結果[ 3 ]
End Sub
'
'【メモ】
'
'大文字/小文字を正しく区別する単語セパレータ
'   Null 値                         (Chr$(0))
'   水平タブ                        (Chr$(9))
'   ライン フィード                 (Chr$(10))
'   垂直タブ                        (Chr$(11))
'   フォーム フィード               (Chr$(12))
'   キャリッジ リターン             (Chr$(13))
'   およびスペース (SBCS の場合)    (Chr$(32))
'   ※DBCS のスペースの実際の値は、国によって異なります。
'
'【解説】
'
'ANSI 形式のバイト型配列を文字列に変換する場合
'   StrConv 関数を使用してください。
'Unicode 形式の配列を変換する場合
'   代入式を使用してください。


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 文字中の指定文字と指定文字間の文字を全て検索

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub SearchAllLettersBetween(str As String, strFoundFront As String, strFoundBack As String)
'************************************************
'文字中の指定文字と指定文字間の文字を全て検索
'************************************************
'引数strは対象文字群
'引数strFoundFrontは前方検索対象文字
'引数strFoundBackは後方検索対象文字

'<例>
'str = "zyzyzyzabc="def"zyzyzyzabc="ghij"zyz"
'strFoundFront = "abc="
'strFoundBack = """"
'返値は [abc="def"] と[abc="ghij"] になります。

'<解説>
'Replace関数で一度検索したものは全て消すところがミソ!
'検索文字がなくなるまで実行します。
'書き出したい場合は[Debug.Print Xa]の個所を改変してください。

Dim i As Long, Xa As String, Xb As Long

reTRY: '再帰①
i = InStr(1, str, strFoundFront) '前方検索対象文字位置
If i = 0 Then GoTo TheEnd: '無ければ終了②
Xb = InStr(i + Len(strFoundFront) + 1, str, strFoundBack) '後方検索対象文字位置
Xa = Mid(str, i, Xb - i + 1) '値をゲット
Debug.Print Xa
str = Replace(str, Xa, "") 'ゲット後は削除する(対象文字群内全て)

GoTo reTRY: '再帰①
TheEnd: '無ければ終了②
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 OpenTextメソッド

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

OpenText メソッド

テキスト ファイルを分析して読み込みます。テキスト ファイルを 1 枚のシートとして、それを含む新しいブックを開きます。

  • 構文

  • expression.OpenText(Filename, Origin, StartRow, DataType, TextQualifier, ConsecutiveDelimiter, Tab, Semicolon, Comma, Space, Other, OtherChar, FieldInfo, DecimalSeparator, ThousandsSeparator)
  • expression
    必ず指定します。対象となる Workbooks コレクションを表すオブジェクト式を指定します。
  • Filename
    必ず指定します。文字列型 (String) の値を使用します。読み込まれるテキスト ファイルの名前を指定します。
  • Origin
    省略可能です。バリアント型 (Variant) の値を使用します。テキスト ファイルが作成された機種を指定します。使用できる定数は、XlPlatform クラスの xlMacintosh、xlWindows、xlMSDOS のいずれかです。この引数を省略すると、現在のテキスト ファイル ウィザードを使用している機種が指定されます。
  • StartRow
    省略可能です。バリアント型 (Variant) の値を使用します。取り込む開始行を指定します。最初の行を 1 として数えます。既定値は 1 です。
  • DataType
    省略可能です。バリアント型 (Variant) の値を使用します。ファイルに含まれるデータの形式を指定します。使用できる定数は、XlTextParsingType クラスの xlDelimited または xlFixedWidth です。既定値は xlDelimited です。
  • TextQualifier
    省略可能です。バリアント型 (Variant) の値を使用します。文字列の引用符を指定します。使用できる定数は、XlTextQualifier クラスの xlTextQualifierDoubleQuote、xlTextQualifierSingleQuote、xlTextQualifierNone です。既定値は xlTextQualifierDoubleQuote です。
  • ConsecutiveDelimiter
    省略可能です。バリアント型 (Variant) の値を使用します。連続した区切り文字を 1 文字として扱うときは True を指定します。既定値は False です。
  • Tab
    省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にタブを使うときは True を指定します。既定値は False です。
  • Semicolon
    省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にセミコロン (;) を使うときは True を指定します。既定値は False です。
  • Comma
    省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にカンマ (,) を使うときは True を指定します。既定値は False です。
  • Space
    省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にスペースを使うときは True を指定します。既定値は False です。
  • Other
    省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字に OtherChar で指定した文字を使うときは True を指定します。既定値は False です。
  • OtherChar
    省略可能です。バリアント型 (Variant) の値を使用します。引数 Other が True のときは、必ずこの引数に区切り文字を指定します。複数の文字を指定したときは、先頭の文字が区切り文字となり、残りの文字は無視されます。
  • FieldInfo
    省略可能です。バリアント型 (Variant) の値を使用します。各列のデータ形式を示す配列を指定します。データ形式の解釈は、引数 DataType に指定された値によって異なります。
  • 引数 DataType
    が xlDelimited のとき (データが区切り文字で区切られているとき) は、この引数には 2 つの要素を持つ配列の配列を指定します。2 つの要素を持つ配列の 1 つずつが、各列の処理方法を決定します。1 番目の要素には 1 から始まる列の番号を指定し、2 番目の要素には各列の変換方法を指定する、次の xlColumnDataType クラスの定数のいずれかを指定します。
  • 定数 内容
    xlGeneralFormat 一般
    xlTextFormat テキスト
    xlMDYFormat MDY (月日年) 形式の日付
    xlDMYFormat DMY (日年月) 形式の日付
    xlYMDFormat YMD (年月日) 形式の日付
    xlMYDFormat MYD (月年日) 形式の日付
    xlDYMFormat DYM (日年月) 形式の日付
    xlYDMFormat YDM (年日月) 形式の日付
    xlEMDFormat EMD (台湾年月日) 形式の日付
    xlSkipColumn スキップ列
  • 定数 xlEMDFormat
    は、簡易字中国語サポートがインストールおよび選択されている場合にのみ使用できます。定数 xlEMDFormat は、日付形式に台湾の元号が使用されていることを指定します。
  • 列の指定は
    、どのような順番でもかまいません。指定されなかった列は、一般の形式だと解釈されます。次の例では、3 番目の列は削除され、最初の列は文字列として解釈され、残りの列は一般の形式として解釈されます。
  • Array(Array(3, 9), Array(1, 2))
  • 引数 DataType
    が xlFixedWidth のとき (データが固定長で区切られているとき)、配列の 1 番目の要素には、行のどの位置から処理が行われるかを 0 から始まる整数で指定します。2 番目の要素には変換方法を 1 ~ 9 の数値で指定します (上の対応表参照)。
  • 次の例は、
    固定長のテキスト ファイルから 2 つの列を読み込みます
    。最初の列は行頭から 10 文字目までが入ります。11 文字目から 15 文字目まではスキップします。2 番目の列は 16 文字目から行の終わりまでとなります。
  • Array(Array(0, 1), Array(10, 9), Array(15, 1))
  • DecimalSeparator
    省略可能です。文字列型 (String) の値を使用します。Excel で数値を認識する場合に使う小数点の記号です。既定はシステム設定です。
  • ThousandsSeparator
    省略可能です。文字列型 (String) の値を使用します。Excel で数値を認識する場合に使う桁区切り記号でです。既定はシステム設定です。
  • さまざまなインポート設定
    でテキストを Excel にインポートする結果を次に示します。数値の結果は右詰めで表示します。
  • システムの小数点の記号 システムの桁区切りの記号 小数点の記号の値 桁区切りの記号の値 インポートしたテキスト セルの値 (データ型)
    ピリオド カンマ カンマ ピリオド 123.123,45 123,123.45 (数値)
    ピリオド カンマ カンマ カンマ 123.123,45 123.123,45 (文字列)
    カンマ ピリオド カンマ ピリオド 123123.45 123,123.45 (数値)
    ピリオド カンマ ピリオド カンマ 123 123.45 123 123.45 (文字列)
    ピリオド カンマ ピリオド スペース 123 123.45 123,123.45 (数値)
  • OpenText メソッドの使用例
  • 次の使用例は、Data.txt というテキスト ファイルを、タブを区切り文字として分析し、ワークシートに変換します。
Option Explicit

Workbooks.OpenText Filename:="DATA.TXT", _
    DataType:=xlDelimited, Tab:=True

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 Len関数の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'次の例は、Len 関数を使って、文字列の文字数、または変数の保存に必要なバイト数を返します。CustomerRecord を定義する Type...End Type ブロックをクラス モジュール内で記述する場合、このブロックの直前にキーワード Private を付ける必要があります。標準モジュールでは、Type ステートメントでパブリックなユーザー定義型を定義できます。

Type CustomerRecord                ' ユーザー定義型を定義します。
    ID As Integer                    ' この定義は標準モジュール内に記述します。
    Name As String * 10
    Address As String * 30
End Type

Dim Customer As CustomerRecord        ' 変数を宣言します。
Dim MyInt As Integer, MyCur As Currency
Dim MyString, MyLen
MyString = "Hello World"            ' 変数を初期化します。
MyLen = Len(MyInt)                ' 2 を返します。
MyLen = Len(Customer)            ' 42 を返します。
MyLen = Len(MyString)            ' 11 を返します。
MyLen = Len(MyCur)                ' 8 を返します。

'次の例では、LenB 関数とユーザー定義関数 LenMbcs を使用して、指定した文字列のバイト数を返します。32 ビット Windows 用の VBA を使用する場合と、Macintosh用の VBA を使用する場合とでは、返される結果が異なる点に注意してください。

Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

Dim MyString, MyLen
MyString = "ABc"
' "A" と "B" は全角文字で "c" は半角文字です。
MyLen = Len(MyString)
' 文字数として 3 が返されます。
MyLen = LenB(MyString)
' Windows の場合は 6、Macintosh の場合には 5 がバイト数として返されます。
MyLen = LenMbcs(MyString)
' Windows の場合は 5 が返されます。Macintosh の場合は
' Unicode がサポートされていないため、エラーが返されます。

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 Like演算子で英語数字漢字ひらがなカタカナを判別する文字列をキーワード毎に分ける

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Private Function LetterNo(letter As StringAs Byte
'****************************************************
'Like演算子で英語数字漢字ひらがなカタカナを判別する
'****************************************************
'英語[1]・数字[2]・漢字[3]
'全角ひらがな大[4]・全角ひらがな小[4]
'全角カタカナ大[5]・全角カタカナ小[5]
'長音ー[0]・その他[6]を返す
'※引数letterには1文字だけ
'※返り値はバイト数
'※長音[ー]で始まるひらがなカタカナは無いとみなす。
'※特殊文字は対象外[6]する

If letter = "_" Then LetterNo = 6: Exit Function
If letter Like "[A-Z]" = True Then LetterNo = 1: Exit Function
If letter Like "[a-z]" = True Then LetterNo = 1: Exit Function
If letter Like "[A-z]" = True Then LetterNo = 1: Exit Function
If letter Like "[0-9]" = True Then LetterNo = 2: Exit Function
If letter Like "[0-9]" = True Then LetterNo = 2: Exit Function
If letter Like "[一-龠]" = True Then LetterNo = 3: Exit Function
If letter Like "[あ-ん]" = True Then LetterNo = 4: Exit Function
If letter Like "[ア-ン]" = True Then LetterNo = 5: Exit Function
If letter = "ー" Then LetterNo = 0: Exit Function

LetterNo = 6

End Function


Function LetterKeyword(LongLetter As String)
'****************************************************
'文字列をキーワード毎に分ける
'****************************************************
'※特殊文字は除外する
'※1文字は除外する
Dim i As Long
Dim NowNumber As Byte       '現在番号
Dim FncNo As Byte           '関数から得た番号
Dim PreviousNumber As Byte  '前の番号
Dim MemoryNumber As Byte    '記憶番号
Dim ExclusionNumber As Byte '除外番号
Dim TmpLetter As String     '仮の文字
Dim Character As String     '処理中の1文字
Dim Spl As Variant

PreviousNumber = 9: MemoryNumber = 9 '初期化
ExclusionNumber = 9                  '初期化
    For i = 1 To Len(LongLetter)
        Character = Mid(LongLetter, i, 1)
        FncNo = LetterNo(Character) 'Function LetterNo
            '長音[ー]処理
            If FncNo = 0 Then
                NowNumber = MemoryNumber
            ElseIf FncNo = 6 Then
                ExclusionNumber = ExclusionNumber + 1
                NowNumber = ExclusionNumber
                MemoryNumber = ExclusionNumber
            Else
                NowNumber = FncNo
                MemoryNumber = FncNo
            End If
            '区切り処理
            If NowNumber <> PreviousNumber Then
                TmpLetter = TmpLetter & "," & Character
                PreviousNumber = NowNumber
            Else
                TmpLetter = TmpLetter & Character
            End If
    Next i
Spl = Split(TmpLetter, ",")
TmpLetter = "" '初期化
    For i = LBound(Spl) To UBound(Spl)
        '※1文字は除外する
        If Not Len(Spl(i)) <= 1 Then
            TmpLetter = TmpLetter & Spl(i) & ","
        End If
    Next i
LetterKeyword = TmpLetter
End Function


Private Sub test()
Dim str As String
str = "XP_Office_2000/[XP]/2003用SP統合ソフト_SP+メーカーOffice_2000編"
MsgBox LetterKeyword(str)
Debug.Print LetterKeyword(str)
'XP,Office,2000,XP,2003,SP,統合,ソフト,SP,メーカー,Office,2000,
End Sub


文字操作 0~9・a~z・あ~ん・ア~ンのようなグループに属するか判断するLike演算子

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 CSV形式テキストファイル出力

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub AddCSV()
'*******************************
'CSV形式テキストファイル出力
'*******************************
'フィールド名に「日」の文字を含む場合"yyyy/mm/dd"形式にする。
On Error GoTo error:

Dim sht(1 To 2) As Worksheet
Dim bok As Workbook
Dim MyPath As String
Dim MyPath2 As String
Dim i As Byte
Dim j As Long
Const shtFol As String = "\Backup"
Dim Fso As Object
Dim Chack As Boolean

Set bok = Workbooks("pdpData.xls")
Set sht(1) = bok.Worksheets("会計伝票")
Set sht(2) = bok.Worksheets("カルテ")

Application.ScreenUpdating = False
   
Set Fso = CreateObject("Scripting.FileSystemObject")
    
MyPath2 = bok.Path & shtFol
    
Chack = Fso.Folderexists(MyPath2)
    
If Chack = False Then   '無ければ作成
    Fso.createfolder (MyPath2)
End If
   
Set Fso = Nothing
   
MyPath = bok.Path & shtFol & "\"


For i = 1 To 2
    With sht(i)
    If Dir(MyPath & .Name & ".csv") <> "" Then Kill MyPath & .Name & ".csv"
        Application.DisplayAlerts = False
            For j = 1 To .Range("A1").SpecialCells(xlCellTypeLastCell).Column
                If InStr(1, .Cells(1, j).Value, "日") <> 0 Then
                    .Columns(j).NumberFormat = "yyyy/mm/dd"
                End If
            Next j
        .Copy
        ActiveWorkbook.SaveAs Filename:=MyPath & .Name & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
    End With
    Set sht(i) = Nothing
Next i

Set bok = Nothing

MsgBox MyPath & "バックアップをしました", 0, "Backup"

Exit Sub
error:
MyErrorMsg
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 0~9・a~z・あ~ん・ア~ンのようなグループに属するか判断するLike演算子

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

  1. Like 演算子
    1. 構文
    2. 解説
    3. サンプルコード
    4. メモ
    5. パターン マッチングに関するその他の主な規則
    6. Like 演算子の使用例

Like 演算子

2 つの文字列の比較を行います。

構文

result = string Like pattern Like

演算子の構文は、次の指定項目から構成されます。
指定項目 内容
result 必ず指定します。任意の数値変数を指定します。
string 必ず指定します。任意の文字列式を指定します。
pattern 必ず指定します。「解説」に示すパターン マッチング規則に従った任意の文字列式を指定します。

解説

文字列式 string と文字列式 pattern が一致していると、演算結果 result は真 (True) になります。一致していないときは、演算結果 result は偽 (False) になります。文字列式 string または文字列式 pattern のいずれかが Null 値のときは、演算結果 result も Null 値になります。
Like 演算子の動作は、Option Compare ステートメントの設定によって異なります。各モジュールに対する文字列比較の既定の方法は、Option Compare Binary ステートメントの設定が使われます。
Option Compare Binary ステートメントでは、文字列比較で使われる並べ替え順序は、バイナリ文字コードのコード順によって決まります。並べ替えのコード順としては、シフト JIS コードが使用されます。バイナリ モード (Binary) での並べ替え順序の例を次に示します。
A < B < E < Z < a < b < e < z < A < E < O < a < e < o
Option Compare Text ステートメントでは、文字列比較は、オペレーティング システムの国別情報によって決まり、日本語の場合は 50 音順およびアルファベット順で、大文字小文字を区別しない並べ替え順序になります。清音や濁音は、清音、濁音、半濁音の順序で並べ替えられます。テキスト モード (Text) での並べ替え順序の例を次に示します。
(*=*) < (0=0) < (9=9) < (A=a=A=a) < (B=b=B=b) < (ア=ア=あ) < (ン=ン=ん) < 亜
組み込みのパターン マッチング機能では、文字列比較のための便利な機能を利用できます。ワイルドカード、文字リスト、文字範囲などを組み合わせて使用できます。次に文字列式 pattern に指定できる文字と、一致する文字を示します。
文字パターン 引数 string の中の一致する文字
? 任意の 1 文字
* 任意の数の文字
# 任意の 1 文字の数字 (0-9)
[charlist] 文字リスト charlist に指定した文字の中の任意の 1 文字
[!charlist] 文字リスト charlist に指定した文字以外の任意の 1 文字
これらのうち、"#" を除くすべての文字パターンでは、2 バイト文字 (全角文字) も 1 文字と数えて文字列比較を行います。"#" には、1 バイト (半角) の数字だけが一致します。1 個以上の文字のリスト (charlist) を角かっこ ([ ]) で囲んで文字列式 pattern に指定すると、その中のいずれかの文字と、文字列式 string の中の該当する 1 文字が一致するかどうかを比較することができます。角かっこ ([ ]) の中の文字リストには、数字も含め、文字コードおよびシフト JIS コードのほぼすべての文字を指定できます。

サンプルコード

Dim MyCheck
MyCheck = letter Like "[A-Z]"
Debug.Print MyCheck
MyCheck = letter Like "[a-z]"
Debug.Print MyCheck
MyCheck = letter Like "[A-z]"
Debug.Print MyCheck
MyCheck = letter Like "[A-Z]"
Debug.Print MyCheck
MyCheck = letter Like "[a-z]"
Debug.Print MyCheck
MyCheck = letter Like "[A-z]"
Debug.Print MyCheck

MyCheck = letter Like "[0-9]"
Debug.Print MyCheck
MyCheck = letter Like "[0-9]"
Debug.Print MyCheck

MyCheck = letter Like "[一-龠]"
Debug.Print MyCheck

MyCheck = letter Like "[あ-ん]"
Debug.Print MyCheck
MyCheck = letter Like "[ぁ-ゎ]"
Debug.Print MyCheck
MyCheck = letter Like "[あ-ゎ]"
Debug.Print MyCheck

MyCheck = letter Like "[ア-ン]"
Debug.Print MyCheck
MyCheck = letter Like "[ァ-ヮ]"
Debug.Print MyCheck
MyCheck = letter Like "[ア-ヮ]"
Debug.Print MyCheck
True=1
False=0
英語 数値 漢字 ひらがな カタカナ
半角 全角 半角 全角 全角 全角 全角
F f 0
[A-Z] 1 0 0 0 0 0 0 0 0 0 0
[a-z] 0 1 0 0 0 0 0 0 0 0 0
[A-z] 1 1 0 0 0 0 0 0 0 0 0
[A-Z] 0 0 1 0 0 0 0 0 0 0 0
[a-z] 0 0 0 1 0 0 0 0 0 0 0
[A-z] 0 0 1 1 0 0 0 0 0 0 0
[0-9] 0 0 0 0 1 0 0 0 0 0 0
[0-9] 0 0 0 0 0 1 0 0 0 0 0
[一-龠] 0 0 0 0 0 0 1 0 0 0 0
[あ-ん] 0 0 0 0 0 0 0 1 1 0 0
[ぁ-ゎ] 0 0 0 0 0 0 0 1 1 0 0
[あ-ゎ] 0 0 0 0 0 0 0 1 1 0 0
[ア-ン] 0 0 0 0 0 0 0 0 0 1 1
[ァ-ヮ] 0 0 0 0 0 0 0 0 0 1 1
[ア-ヮ] 0 0 0 0 0 0 0 0 0 1 1

メモ

特殊文字の左角かっこ ([)、疑問符 (?)、数値記号 (#)、およびアスタリスク (*) を文字列比較するには、これらの文字を角かっこで囲みます。右角かっこ (]) をワイルドカードとしてではなくその文字自体として文字列比較を行うときには、右角かっこを他の文字と共に角かっこで囲んでリストの中に指定することはできません。右角かっこは、文字のリストに入れずに単独で指定すると、独立した文字として、文字列の中の文字と比較できます。
角かっこの中に指定する文字リスト charlist には、文字コードの並びの上限と下限をハイフン (-) で区切ることによって、特定の文字範囲を指定することもできます。2 バイト文字も範囲指定でき、漢字の範囲の指定もできます。たとえば、[A-Z] と指定すると、大文字の A から Z までの文字をすべてリストの中に指定したときと同じ意味になり、文字列式 string の中の対応する位置の文字が大文字のアルファベットのいずれか 1 文字であるときに一致します。1 組の角かっこの中に複数の範囲を指定するときは、それぞれの範囲の間を区切らずに記述します。
指定した範囲の意味は、Option Compare ステートメントの設定と、実行時のオペレーティング システムの国別情報の設定によって異なります。Option Compare Binary ステートメントの例では、[A-E] の範囲を指定すると、A、B および E が一致します。Option Compare Text ステートメントでは、[A-E] の範囲を指定すると、A、a、A、a、B、b、E、および e が一致します。この範囲を指定すると、E または e と一致しません。並べ替え順序では、アクセント記号付きの文字はアクセント記号の付いていない文字の後になります。

パターン マッチングに関するその他の主な規則

文字リスト charlist の先頭に感嘆符 (!) を指定すると、文字列 string の中の文字が文字リスト charlist に指定した文字以外のときに、一致することを表します。角かっこの外に指定した感嘆符は、文字としての感嘆符と一致します。
ハイフン (-) を文字リスト charlist の先頭 (感嘆符が使われているときはその直後) または charlist の末尾に指定したときは、文字としてのハイフンと一致します。それ以外の位置に指定したハイフンは、ASCII コードおよびシフト JIS コードの文字の範囲を表します。
文字の範囲を指定するとき、文字の順序は昇順 (低い方から高い方へ) でなければなりません。たとえば、[A-Z] と指定することはできますが、[Z-A] と指定すると文字の範囲は正しく解釈されません。
角かっこの中に何も指定しないと ([])、長さ 0 の文字列 (") とみなされます。
一部の言語には、離れている 2 つの文字を意味する特殊文字がアルファベットに含まれています。たとえば、いくつかの言語では、文字 "a" と "e" が共に表示されるときに、文字 "a" を使って表します。Like 演算子は、単一の特殊文字と、異なる 2 つの文字が同等であると認識します。
このような特殊文字を使う言語をオペレーティング システムの国別情報で設定すると、文字列式 pattern または文字列式 string 内の一方の特殊文字は、他方の文字列内の同等な連続する 2 文字と一致します。同様に角かっこで囲まれた (角かっこ自体はリスト内または範囲内にある) 文字列式 pattern 内の単一の特殊文字は、文字列式 string 内の同等の連続する 2 文字と一致します。

Like 演算子の使用例

次の例は、Like 演算子を使って、文字列とパターンを比較します。
Option Explicit

Dim MyCheck
MyCheck = "aBBBa" Like "a*a"            ' True を返します。
MyCheck = "F" Like "[A-Z]"              ' True を返します。
MyCheck = "F" Like "[!A-Z]"             ' False を返します。
MyCheck = "a2a" Like "a#a"              ' True を返します。
MyCheck = "aM5b" Like "a[L-P]#[!c-e]"   ' True を返します。
MyCheck = "BAT123khg" Like "B?T*"       ' True を返します。
MyCheck = "CAT123khg" Like "B?T*"       ' False を返します。


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 HTML文法では使えない文字を変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Function TAGletterConversion(strLetter As StringAs String
'***********************************
'HTML文法では使えない文字を変換
'***********************************
'strLetter 通常のテキストデータ

Dim cntWord As Long
Dim strWord As String
Dim strNewWord As String
Dim i As Long

Dim strNewLetter As String

cntWord = Len(strLetter) '文字数

For i = 1 To cntWord
    strWord = Mid(strLetter, i, 1)
        Select Case Asc(strWord)  '文字コード判別
            Case 13: strNewWord = "<br>"
            Case 32: strNewWord = "&nbsp;"
            Case 34: strNewWord = "&quot;"
            Case 38: strNewWord = "&amp;"
            Case 60: strNewWord = "&lt;"
            Case 62: strNewWord = "&gt;"
            Case Else: strNewWord = strWord
        End Select
    strNewLetter = strNewLetter & strNewWord
Next i
    TAGletterConversion = strNewLetter
'-------------------------------------------------------------------
'Asc 関数
'指定した文字列内にある先頭の文字の文字コードを返す変換関数です。
Debug.Print Asc(vbCr)
Debug.Print Asc(" ")
Debug.Print Asc("""")
Debug.Print Asc("&")
Debug.Print Asc("<")
Debug.Print Asc(">")
'13
'32
'34
'38
'60
'62

'Chr 関数
'指定した文字コードに対応する文字を示す文字列型 (String) の値を返します。
Debug.Print Chr(13)
Debug.Print Chr(32)
Debug.Print Chr(34)
Debug.Print Chr(38)
Debug.Print Chr(60)
Debug.Print Chr(62)
'キャリッジ リターン
'空白(半角スペース)
'"
'&
'<
'>

End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

連携 別ブックのマクロを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Application.Run "odo.xls Macro2"

 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 他のブックのSub・Functionステートメントを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub OthersBookSub(strPath As String, FileName As String, ModuleName As String _
, StatementName As String)
'****************************************
'他のブックのSubステートメントを実行する
'****************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名(パスは不要・.xlsは必要)
'ModuleName:    呼び出すモジュール名(Module1など)
'StatementName: 呼び出すSubステートメント名(Testなど)

Dim bk As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

Application.Run FileName & "!" & ModuleName & "." & StatementName

bk.Close SaveChanges:=False

Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True

'使用例
'(各項目を変数で記述する場合)
'Application.Run NewBok.Name & "!" & "Module5" & "." & "ExcelSheetAllProtect"
'(直接記述)
'Application.Run "NewBok.xls!Module5.ExcelSheetAllProtect"

'※実際はこのような2重な使い方はしません。
End Sub


Function OthersBookFun(strPath As String, FileName As String, ModuleName As String _
, StatementName As String, vrn As VariantAs Variant
'**********************************************
'他のブックのFunctionステートメントを実行する
'**********************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名(パスは不要)
'ModuleName:    呼び出すモジュール名
'StatementName: 呼び出すFunctionステートメント名
'vrn:           呼び出すFunctionステートメントの引数
Dim bk As Workbook, vr As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

vr = _
Application.Run(FileName & "!" & ModuleName & "." & StatementName, vrn)

bk.Close SaveChanges:=False
Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
OthersBookFun = vr

'使用例は上記参照

'※実際はこのような2重な使い方はしません。
End Function


Private Sub test()
Dim sht As Worksheet, strad As String, Lad As String
Dim XlsName As String
XlsName = "test.xls"
Set sht = ThisWorkbook.Worksheets("test")

With sht
    strad = .Cells(.Cells(65536, 4).End(xlUp).Row, 2).Value
End With

Lad = ServerAddressLocal(strad) & "\"
OthersBookSub Lad, XlsName, "testModule", "testsub"
End Sub


 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 指定シートをPDFファイルにして保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub MakingPDF()
'*****************************************
'実行コード
'*****************************************
'PDFCreator.exeの参照設定が不可の場合は終了
If PDFCreatorFromFile = False Then Exit Sub
'作成実行
PrintToPDF_Early
End Sub


Function PDFCreatorFromFile() As Boolean
'*****************************************
'PDFCreator.exe参照設定
'*****************************************

    Dim objName As String

    'PDFCreator.exeの場所
    objName = "C:\Program Files\PDFCreator\PDFCreator.exe"

    If Dir(objName) = "" Then
        MsgBox "「PDFCreator.exe」が見つかりません!", vbCritical, "参照設定Error!"
        PDFCreatorFromFile = False
    Else
        ThisWorkbook.VBProject.References.AddFromFile (objName)
        PDFCreatorFromFile = True
    End If

End Function


Sub PrintToPDF_Early()
'*****************************************
'選択中のシートをPDFファイルに変換する
'*****************************************
'無料オープンソース[PDFCreator]
'http://sourceforge.net/projects/pdfcreator/
'参考ソース
'http://www.excelguru.ca/node/21
'PDFCreator参照設定必要
'試した動作環境:XP HE SP3,EXCEL2000(VB6.0)


    Dim PDFオブジェクト As PDFCreator.clsPDFCreator
    Dim PDFファイル名 As String
    Dim PDF作成パス As String

    '作成するPDFファイル名指定
    PDFファイル名 = "テスト.pdf" '日本語OK
    'そのPDFファイルの保存場所
    PDF作成パス = ActiveWorkbook.Path & Application.PathSeparator
    'PathSeparator:(\) を返す
    '※パスを個別に指定する場合、日本語に対応するか不明

    '空の値の場合は終了(シート空白)
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
    'IsEmpty:Empty 値の場合に、真 (True) を返す
    'UsedRange:指定されたワークシートで使われたセル範囲 (Range オブジェクト) を返す

    Set PDFオブジェクト = New PDFCreator.clsPDFCreator

    'PDFCreatorへの命令
    With PDFオブジェクト
        If .cStart("/NoProcessingAtStartup") = False Then '(※注意)
            MsgBox "PDFCreatorが初期化されていません!", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = PDF作成パス
        .cOption("AutosaveFilename") = PDFファイル名
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With
    '(※注意)PDFCreatorが挙動がおかしく動作しない場合は
    'タスクマネージャープロセスからPDFCreatorを強制終了させる。
    'タスクマネージャー[alt]+[ctrl]+[del]

    '印刷実行プリンターは「PDFCreator」を選択
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    'オペレーティング システムに制御
    Do Until PDFオブジェクト.cCountOfPrintjobs = 1
        DoEvents
    Loop
    PDFオブジェクト.cPrinterStop = False

    'オペレーティング システムに制御
    Do Until PDFオブジェクト.cCountOfPrintjobs = 0
        DoEvents
    Loop

    'PDFCreator閉じる
    PDFオブジェクト.cClose

    'PDFCreator開放
    Set PDFオブジェクト = Nothing
End Sub


 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 他のブックのAuto_Openプロシージャを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub AppRun()
'*******************************************************************************
'他のブックのAuto_Openプロシージャを実行する
'*******************************************************************************
Application.Run "見積書作成.xls Auto_Open"

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 Excelの起動・アクティブ・終了時にマクロを実行-イベント内に記述する方法

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

WorkbookEvent

自動実行には2通りの方法がある。エクセル起動後全てに発生させるAuto_Openと各ブック単位で発生させるワークブックイベントここではワークブックイベントの記述方法を紹介します

  • Visual Basic Editor起動
  • ThisWorkbook オブジェクト
  • ダブルクリック
  • ※Sheetに対しても設置可能です。
  • 右上の
  • Object
  • Workbookにする
  • Workbookしかない
  •  
  • いきなり
  • Workbook_Openが記述されます。
  • 不要な場合は後で消せます。
  • 他のイベントを選択するには
  • 図のように選択します。
  • イベント名とその働きは下図を参考にして下さい。
Option Explicit


Private Sub Workbook_Open()
    MsgBox "Workbook_Open"
End Sub


Private Sub Workbook_Activate()
    MsgBox "Workbook_Activate"
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    MsgBox "Workbook_BeforeClose"
End Sub

Workbookイベント一覧<2000>

イベント 対象 働き(タイミング)
Workbook Activate ブック アクティブになったら発生
AddinInstall アドインとして組み込まれたら発生
AddinnUninstall アドインから解除されたら発生
BeforeClose 閉じられる前
BeforePrint 印刷される前
BeforeSave 保存される前
Deactive アクティブでなくなったら発生
NewSheet 新規シートを追加されたら発生
Open 開かれたら発生
SheetActive シート アクティブになったら発生
SheetBeforeDoubleClick ダブルクリックされたら発生
SheetBeforeRightClick 右クリックされたら発生
SheetCalculate 再計算されたら発生
SheetChange セルの値が変更されたら発生
SheetDeactive アクティブでなくなったら発生
SheetFollowHyperlink ハイパーリンクをクリックしたら発生
SheetSelectionChange セルの選択範囲が変更されたら発生
WindowActivate ウインドウ アクティブになったら発生
WindowDeactivate アクティブでなくなったら発生
WindowResize 大きさが変更されたら発生
Worksheetkイベント一覧
Option Explicit


Private Sub Worksheet_Activate()
'アクティブになったら発生
End Sub


Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)      '引数が必要
'ダブルクリックされたら発生
End Sub


Private Sub Worksheet_BeforeRightClick _
(ByVal Target As Range, Cancel As Boolean)      '引数が必要
'右クリックされたら発生
End Sub


Private Sub Worksheet_Calculate()
'再計算されたら発生
End Sub


Private Sub Worksheet_Change _
(ByVal Target As Range)                         '引数が必要
'セルの値が変更されたら発生
End Sub


Private Sub Worksheet_Deactivate()
'アクティブでなくなったら発生
End Sub


Private Sub Worksheet_FollowHyperlink _
(ByVal Target As Hyperlink)                     '引数が必要
'ハイパーリンクをクリックしたら発生
End Sub


Private Sub Worksheet_SelectionChange _
(ByVal Target As Range)                         '引数が必要
'セルの選択範囲が変更されたら発生
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 WindowsScriptHostを使いVBやVBA制御

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

WindowsScriptHost

  • WSH(Windows Script Host)-VBS-スクリプト言語
  • WSHはスクリプト言語VBScriptやJScriptを利用可能
  • COMオブジェクト(Windows機能)を制御可能
  • VBScriptの拡張子[.vbs]
  • JScriptの拡張子[.js]
  • [.wsf]利用可能
  • 記述編集にはテキスト・エディタを使用する又は
  • Office付属するMicrosoft Script Editorを使用する
  • 実行はダブルクリックで実行可能
  • スクリプト・ホストは以下の2種類
  • wscript.exe(WScript)入力-ダイアログ・ボックス、出力-メッセージ・ボックスつまり「GUIベース」
  • script.exe(CScript)入力-コマンド・プロンプト、出力-コマンド・プロンプトつまり「コンソール・ベース」
上がVBScript[.vbs] 下がJScript[.js]

test.vbs内容記述
'// 全ドライブのごみ箱を空にする。

Set shell = WScript.CreateObject( "Shell.Application" )
For Each DesktopFolder In shell.NameSpace( 0 ).Items
If DesktopFolder.Name = "ごみ箱" Then
DesktopFolder.InvokeVerb "ごみ箱を空にする(&B)"
WScript.Quit 0
End If
Next

上のtest.vbsを実行すると

test.js内容記述
// メモ帳を起動する

// 変数定義
exec = "notepad.exe";
// 検索
var shell = WScript.CreateObject( "WScript.Shell" );
shell.Run( exec );

下のtest.jsを実行すると

編集記述は通常はメモ帳で十分(右クリック-編集)
Microsoft Script Editorでも編集可能

実際のMicrosoft Script Editor画面

TestVBS.vbsを実行する

TestVBS.vbs内容記述
'// エクセルVBAマクロを実行する

set obj = CreateObject("Excel.Application")
obj.Workbooks.Open("C:\Temp\test.xls")
obj.Visible = true
obj.run "TestSub"
test.xlsのTestSub内容記述

Option Explicit


Sub TestSub()
    MsgBox "成功!"
End Sub
通常の起動だとセキュリティ設定にもよるが 図のようなメッセージが表示される .vbsからの起動だと表示されない

 

 

 

2000年01月01日[VBサンプルコード]:[連携]

連携 CSVファイルをmdbファイルに取り込むMicrosoftAccess

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Microsoft Excelでは65536の壁があるため巨大なデータは取り込めない

Microsoft Accessのファイル-開く

テキストリンクウィザードが自動で現れる

格納されている事を確認

 

 

 

2000年01月01日[VBサンプルコード]:[連携]

文字操作 ドライブを表す文字を返します。

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Function GetDriveObjectStr(str As StringAs String
'*******************************************************************************
'ドライブを表す文字を返します。
'*******************************************************************************
    Dim Fso
    Set Fso = CreateObject("Scripting.FileSystemObject")
    ''C:を返します
    GetDriveObjectStr = Fso.GetDriveName(str)
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 スペースを使用したファイル名などのパラメータの記述

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


strFileName =  ""C:\Test No1\Test.txt"" ""C:\Test No2\Test.txt"" 

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 テキストファイル読込レコード数5

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub TxtOpen()
'Tool_Name
'テキストファイル読込(y=レコード数5)
Dim strTarget As String
Dim x As Integer
'y=Dim y As Integer
Dim sht As Worksheet
Dim txtTar As String
Dim MyPath As String

Set sht = Workbooks("Test.xls").Worksheets("Sheet1") '**SET**
txtTar = "tst.txt" '**SET**
MyPath = "C:\WINDOWS\デスクトップ" '**SET**

Application.ScreenUpdating = False

sht.Columns("a:a").Clear 'y=sht.Columns("a:a").Clear

sht.Activate

Open MyPath & "\" & txtTar For Input As #1 'ターゲットテキストオープン
Do Until EOF(1)
Input #1, strTarget
'y=Input #1, strTarget(1),strTarget(2),strTarget(3),strTarget(4),strTarget(5)
'y=For y = 1 to 5
x = x + 1
Cells(x, 1) = strTarget 'y=(y)
'y=Next y
Loop

Close #1

Set sht = Nothing
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 Split関数で文字列を分割

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub LetterSplit()
'****************************
'Split関数で文字列を分割
'****************************
'引数が空白でもエラーは起りません
'引数内に区切り文字(検索文字)がない場合でもエラー無し

Dim moji As String
Dim FoundMoji As String
Dim Msg As String
Dim j As Variant
Dim i As Long

moji = "あ a v  GG"
FoundMoji = " "

'区切り文字(検索文字)がスペースの場合は引数不要
j = Split(moji)
'j = Split(moji, FoundMoji)
    For i = LBound(j) To UBound(j)
    Msg = Msg & i + 1 & vbTab & j(i) & vbCr
    Next i
MsgBox Msg

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 OptionCompareステートメント文字列データの既定の比較方法を設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Compare ステートメント

文字列データの既定の比較方法を設定します。モジュール レベルで使います。

構文

Option Compare {Binary | Text | Database}

解説

Option Compare ステートメントを使う場合は、モジュール内のどのプロシージャよりも前に記述する必要があります。
Option Compare ステートメントは、モジュール内での文字列の比較方法 (Binary モード、Text モード、または Database モード) を指定するものです。Option Compare ステートメントが記述されていないモジュールでは、既定の文字列比較方法である Binary モードが使われます。
Binary モード
では、文字列比較の並べ替え順序は、バイナリ文字コードのコード順によって行われます。Microsoft WIndows 版 Visual Basicでは 、文字コードは Unicode で表現されるので、結果は Unicode のコード順によって決まります。Binary モードでの並べ替えの例を次に示します。(ただし、バージョン4.0 以前の Windows 16bit 版 Visual Basic、または Macintosh 版 Visual Basic では、文字コードはシフト JISで表現されていたため、結果が異なる場合があります。)
* < "a" < "z" < "あ" < "ん" < "ア" < "ン" < "亜" < "*" < "A" < "ア" < "ン"
Text モード
では、文字列比較は、オペレーティング システムの国別情報の設定で決まります。日本語/日本の場合は、50 音順で、大文字と小文字、文字幅、カタカナとひらがなを区別しない並べ替え順になります。Text モードでの並べ替えの例を次に示します。
(*=*) < (0=0) < (9=9) < (A=a=A=a) < (B=b=B=b) < (ア=ア=あ) < (ン=ン=ん) < 亜
Database モードは、Microsoft Access でのみ使用できます。このモードの文字列比較の並べ替え順序は、データベースの文字列比較に適用される国別の ID によって決まります。

Option Compare ステートメントの使用例

次の例では、Option Compare ステートメントを使って、既定の文字列比較方法を変更します。Option Compare ステートメントは、モジュール レベルでのみ使用します。
' 文字列比較方法を Binary モードに設定します。
Option Compare Binary     ' "AAA" は、"aaa" よりも小さくなります。
' 文字列比較方法を Text モードに設定します。
Option Compare Text        ' "AAA" と "aaa" は、等価です。

その他のOption キーワード

Option Base ステートメント
配列の添字の最小値の既定値を設定します。モジュール レベルで使用します。


'Option Base ステートメントの使用例
'次の例では、Option Base ステートメントを使って、
'配列の添字の既定の最小値 0 を変更します。LBound
'関数は、配列内の指定された次元の添字の最小値を返します。
'Option Base ステートメントは、モジュール レベルでのみ使います。

Option Base 1            ' 配列の添字の既定値を 1 に設定します。

Dim Lower
Dim MyArray(20), TwoDArray(3, 4)        ' 配列変数を宣言します。
Dim ZeroArray(0 To 5)    ' 添字の既定の最小値を変更します。
' 配列の添字の最小値を求めるには、LBound 関数を使います。
Lower = LBound(MyArray)             ' 1 が返ります。
Lower = LBound(TwoDArray, 2)        ' 1 が返ります。
Lower = LBound(ZeroArray)           ' 0 が返ります。
Option Explicit ステートメント
モジュール内のすべての変数に対して、明示的な宣言を強制します。モジュール レベルで使用します。


'Option Explicit ステートメントの使用例
'次の例では、Option Explicit ステートメントを使って、
'すべての変数を明示的に宣言するように設定します。宣言
'されていない変数を使うとコンパイル時にエラーが発生します。
'Option Explicit ステートメントは、モジュール レベルでのみ使用します。

Option Explicit    ' すべての変数を明示的に宣言するようにします。
Dim MyVar            ' 変数を宣言します。
MyInt = 10        ' 宣言されていない変数を使うとエラーが発生します。
MyVar = 10        ' 宣言済みの変数であれば、エラーは発生しません。
Option Private ステートメント
複数のプロジェクト間で参照可能なホスト アプリケーションにおいて Option Private Module ステートメントを使うと、プロジェクトの外部からモジュールの内容が参照できなくなります。単独で Visual Basic を使用している場合など、外部からの参照を許可しないホスト アプリケーションでは、Option Private ステートメントは無効です。


'Option Private ステートメントの使用例
'次の例では、Option Private ステートメントをモジュール レベルで使って、
'モジュール全体をプライベートとして設定します。Option Private Module
'では、Private 宣言を行っていないモジュール レベルの要素は、そのモジュール
'が含まれるプロジェクト内からは参照できますが、ほかのアプリケーションやほか
'のプロジェクトからは参照できません。

Option Private Module
                        ' モジュールがプライベートであることを示します。

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 キャリッジリターンラインフィード等

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

その他の定数
  • 次の定数は Visual Basic for Applications のタイプ ライブラリで定義されており、実際の値の代わりにコード内のどの部分でも使うことができます。
定数 内容
vbCrLf Chr(13) + Chr(10) キャリッジ リターンとライン フィードの組み合わせ
vbCr Chr(13) キャリッジ リターン文字
vbLf Chr(10) ライン フィード文字
vbNullChar Chr(0) 値 0 を持つ文字
vbNewLine Chr(13) + Chr(10) または Chr(13) (Macintosh では Chr(13)) プラット フォームで指定した改行文字。現在のプラット フォームで適切ないずれかを使用します。
vbNullString 値 0 を持つ文字列 長さ 0 の文字列 (") とは異なります。外部プロシージャを呼び出す場合に使用します。
vbTab Chr(9) タブ文字
vbBack Chr(8) バックスペース文字
vbFormFeed Chr(12) Microsoft Windows または Macintosh では使用できません。
vbVerticalTab Chr(11) Microsoft Windows または Macintosh では使用できません。

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 シート上のテキストから特定文字群を抽出

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub TxtSarch()
'
Dim strTarget As String
Dim x As Long
Dim y As Long
Dim z As Integer
Dim i As Integer
Dim j As Long
Dim k As Byte
Dim sht As Worksheet
Dim shtOut As Worksheet
Dim strFind As String
Dim strFind2 As String
Dim strOutTXT As String

Set sht = Workbooks("Test.xls").Worksheets("Sheet1") '**SET**
Set shtOut = Workbooks("Test.xls").Worksheets("Sheet2") '**SET**

strFind = "zip" '**SET**
strFind2 = "http:" '**SET**

k = Len(strFind)
x = sht.Range("a65536").End(xlUp).Row

For y = 1 To x
    strTarget = sht.Range("a" & y).Value
    i = InStr(strTarget, strFind)
        If i <> 0 Then
            z = InStr(strTarget, strFind2)
                If z <> 0 Then
                    strOutTXT = Mid(strTarget, z, i - z + k)
                    j = shtOut.Range("a1").CurrentRegion.Rows.Count + 1
                    shtOut.Range("a" & j).Value = strOutTXT
                End If
        End If
Next y

Set sht = Nothing
Set shtOut = Nothing

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 ひらがな・カタカナをローマ字(英字)変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Dim strTwo(64, 2) As String, strOne(85, 2) As String


Public Function RomajiConversion(ByVal HiraKata As StringAs String
'****************************************************
'ひらがな・カタカナをローマ字(英字)変換
'****************************************************
'引数[HiraKata]を全てローマ字小文字(英字)変換
'引数[HiraKata]はひらがな・カタカナ何れも変換可能(※1)
'注意 サブプロシージャー[ReadTable]が同じモジュール内に必要
'「なっとう」等の[っ]の場合、ローマ字特有の「na[tt]ou」[tt]を処理(※2)

Dim CnvOne As String, CnvTwo As String
Dim strTemporary As String
Dim str As String
Dim blnFlg As Boolean
Dim cnt As Long
Dim intMach As Integer

ReadTable 'テーブル読込

'(※1)---------------------------------------------------------------------
'vbHiragana : 文字列内のカタカナをひらがなに変換します。
'vbWide : 文字列内の半角文字 (1 バイト) を全角文字 (2 バイト) に変換します。
'既にひらがなの場合はそのまま変換しません。
HiraKata = StrConv(HiraKata, vbHiragana Or vbWide)
'--------------------------------------------------------------------------

'初期設定
strTemporary = ""
cnt = 1
blnFlg = False

Do While cnt <= Len(HiraKata) '文字列全てを処理

  CnvTwo = "" '初期設定
  CnvOne = "" '初期設定

  '注意 Do...Loop ステートメントは永久ループの危険ありの為、使用不可

  '2文字の該当値検索
  str = Mid(HiraKata, cnt, 2) '該当文字格納
  For intMach = 1 To 64
    If str = strTwo(intMach, 1) Then
        CnvTwo = strTwo(intMach, 2)
    Exit For '合致なら抜ける
    End If
  Next intMach

  '1文字の該当値検索
  str = Mid(HiraKata, cnt, 1) '該当文字格納
  For intMach = 1 To 85
    If str = strOne(intMach, 1) Then
        CnvOne = strOne(intMach, 2)
    Exit For '合致なら抜ける
    End If
  Next intMach

  If CnvTwo <> "" Then '2文字変換完了の場合

    If blnFlg Then 'フラグが該当する場合
      strTemporary = strTemporary & Left(CnvTwo, 1)
      '2文字変換中1文字だけ余分に追加
    End If
    strTemporary = strTemporary & CnvTwo '2文字追加
    cnt = cnt + 2 '処理を2つ進める
    blnFlg = False '該当フラグを降ろす

  ElseIf CnvOne <> "" Then '1文字変換完了の場合

    If blnFlg Then 'フラグが該当する場合
      strTemporary = strTemporary & Left(CnvOne, 1)
      '1文字余分に追加
    End If
    strTemporary = strTemporary & CnvOne '1文字追加
    cnt = cnt + 1 '処理を1つ進める
    blnFlg = False '該当フラグを降ろす

  ElseIf Mid(HiraKata, cnt, 1) = "っ" Then
  '(※2)両方無変換の場合で該当文字が「っ」の場合

    blnFlg = True '該当フラグを立てる
    cnt = cnt + 1 '処理を1つ進める

  Else

    strTemporary = strTemporary & Mid(HiraKata, cnt, 1)
    '全てに該当しない場合
    cnt = cnt + 1 '処理を1つ進める

  End If

Loop

RomajiConversion = strTemporary

End Function


Private Sub ReadTable()
'***********************************
'RomajiConversion用テーブル
'***********************************
'*ひらがな・カタカナをローマ字変換テーブル
'「っ」はありません
'「ん」は「n」にて変換、用途により「nn」変更してください。
'長音「ろーま」は「ro-ma」[-]で処理

    strTwo(1, 1) = "きぃ": strTwo(1, 2) = "kyi"
    strTwo(2, 1) = "きぇ": strTwo(2, 2) = "kye"
    strTwo(3, 1) = "きゃ": strTwo(3, 2) = "kya"
    strTwo(4, 1) = "きゅ": strTwo(4, 2) = "kyu"
    strTwo(5, 1) = "きょ": strTwo(5, 2) = "kyo"
    strTwo(6, 1) = "ぎぃ": strTwo(6, 2) = "gyi"
    strTwo(7, 1) = "ぎぇ": strTwo(7, 2) = "gye"
    strTwo(8, 1) = "ぎゃ": strTwo(8, 2) = "gya"
    strTwo(9, 1) = "ぎゅ": strTwo(9, 2) = "gyu"
    strTwo(10, 1) = "ぎょ": strTwo(10, 2) = "gyo"
    strTwo(11, 1) = "しぃ": strTwo(11, 2) = "syi"
    strTwo(12, 1) = "しぇ": strTwo(12, 2) = "she"
    strTwo(13, 1) = "しゃ": strTwo(13, 2) = "sha"
    strTwo(14, 1) = "しゅ": strTwo(14, 2) = "shu"
    strTwo(15, 1) = "しょ": strTwo(15, 2) = "sho"
    strTwo(16, 1) = "じぃ": strTwo(16, 2) = "zyi"
    strTwo(17, 1) = "じぇ": strTwo(17, 2) = "je"
    strTwo(18, 1) = "じゃ": strTwo(18, 2) = "ja"
    strTwo(19, 1) = "じゅ": strTwo(19, 2) = "ju"
    strTwo(20, 1) = "じょ": strTwo(20, 2) = "jo"
    strTwo(21, 1) = "ちぃ": strTwo(21, 2) = "tyi"
    strTwo(22, 1) = "ちぇ": strTwo(22, 2) = "che"
    strTwo(23, 1) = "ちゃ": strTwo(23, 2) = "cha"
    strTwo(24, 1) = "ちゅ": strTwo(24, 2) = "chu"
    strTwo(25, 1) = "ちょ": strTwo(25, 2) = "cho"
    strTwo(26, 1) = "ぢぃ": strTwo(26, 2) = "dyi"
    strTwo(27, 1) = "ぢぇ": strTwo(27, 2) = "dye"
    strTwo(28, 1) = "ぢゃ": strTwo(28, 2) = "dya"
    strTwo(29, 1) = "ぢゅ": strTwo(29, 2) = "dyu"
    strTwo(30, 1) = "ぢょ": strTwo(30, 2) = "dyo"
    strTwo(31, 1) = "にぃ": strTwo(31, 2) = "nyi"
    strTwo(32, 1) = "にぇ": strTwo(32, 2) = "nye"
    strTwo(33, 1) = "にゃ": strTwo(33, 2) = "nya"
    strTwo(34, 1) = "にゅ": strTwo(34, 2) = "nyu"
    strTwo(35, 1) = "にょ": strTwo(35, 2) = "nyo"
    strTwo(36, 1) = "ひぃ": strTwo(36, 2) = "hyi"
    strTwo(37, 1) = "ひぇ": strTwo(37, 2) = "hye"
    strTwo(38, 1) = "ひゃ": strTwo(38, 2) = "hya"
    strTwo(39, 1) = "ひゅ": strTwo(39, 2) = "hyu"
    strTwo(40, 1) = "ひょ": strTwo(40, 2) = "hyo"
    strTwo(41, 1) = "びぃ": strTwo(41, 2) = "byi"
    strTwo(42, 1) = "びぇ": strTwo(42, 2) = "bye"
    strTwo(43, 1) = "びゃ": strTwo(43, 2) = "bya"
    strTwo(44, 1) = "びゅ": strTwo(44, 2) = "byu"
    strTwo(45, 1) = "びょ": strTwo(45, 2) = "byo"
    strTwo(46, 1) = "ぴぃ": strTwo(46, 2) = "pyi"
    strTwo(47, 1) = "ぴぇ": strTwo(47, 2) = "pye"
    strTwo(48, 1) = "ぴゃ": strTwo(48, 2) = "pya"
    strTwo(49, 1) = "ぴゅ": strTwo(49, 2) = "pyu"
    strTwo(50, 1) = "ぴょ": strTwo(50, 2) = "pyo"
    strTwo(51, 1) = "ふぁ": strTwo(51, 2) = "fa"
    strTwo(52, 1) = "ふぃ": strTwo(52, 2) = "fi"
    strTwo(53, 1) = "ふぇ": strTwo(53, 2) = "fe"
    strTwo(54, 1) = "ふぉ": strTwo(54, 2) = "fo"
    strTwo(55, 1) = "みぃ": strTwo(55, 2) = "myi"
    strTwo(56, 1) = "みぇ": strTwo(56, 2) = "mye"
    strTwo(57, 1) = "みゃ": strTwo(57, 2) = "mya"
    strTwo(58, 1) = "みゅ": strTwo(58, 2) = "myu"
    strTwo(59, 1) = "みょ": strTwo(59, 2) = "myo"
    strTwo(60, 1) = "りぃ": strTwo(60, 2) = "ryi"
    strTwo(61, 1) = "りぇ": strTwo(61, 2) = "rye"
    strTwo(62, 1) = "りゃ": strTwo(62, 2) = "rya"
    strTwo(63, 1) = "りゅ": strTwo(63, 2) = "ryu"
    strTwo(64, 1) = "りょ": strTwo(64, 2) = "ryo"

    strOne(1, 1) = "ー": strOne(1, 2) = "-"
    strOne(2, 1) = "ぁ": strOne(2, 2) = "xa"
    strOne(3, 1) = "あ": strOne(3, 2) = "a"
    strOne(4, 1) = "ぃ": strOne(4, 2) = "xi"
    strOne(5, 1) = "い": strOne(5, 2) = "i"
    strOne(6, 1) = "ぅ": strOne(6, 2) = "xu"
    strOne(7, 1) = "う": strOne(7, 2) = "u"
    strOne(8, 1) = "ぇ": strOne(8, 2) = "xe"
    strOne(9, 1) = "え": strOne(9, 2) = "e"
    strOne(10, 1) = "ぉ": strOne(10, 2) = "xo"
    strOne(11, 1) = "お": strOne(11, 2) = "o"
    strOne(12, 1) = "か": strOne(12, 2) = "ka"
    strOne(13, 1) = "が": strOne(13, 2) = "ga"
    strOne(14, 1) = "き": strOne(14, 2) = "ki"
    strOne(15, 1) = "ぎ": strOne(15, 2) = "gi"
    strOne(16, 1) = "く": strOne(16, 2) = "ku"
    strOne(17, 1) = "ぐ": strOne(17, 2) = "gu"
    strOne(18, 1) = "け": strOne(18, 2) = "ke"
    strOne(19, 1) = "げ": strOne(19, 2) = "ge"
    strOne(20, 1) = "こ": strOne(20, 2) = "ko"
    strOne(21, 1) = "ご": strOne(21, 2) = "go"
    strOne(22, 1) = "さ": strOne(22, 2) = "sa"
    strOne(23, 1) = "ざ": strOne(23, 2) = "za"
    strOne(24, 1) = "し": strOne(24, 2) = "shi"
    strOne(25, 1) = "じ": strOne(25, 2) = "ji"
    strOne(26, 1) = "す": strOne(26, 2) = "su"
    strOne(27, 1) = "ず": strOne(27, 2) = "zu"
    strOne(28, 1) = "せ": strOne(28, 2) = "se"
    strOne(29, 1) = "ぜ": strOne(29, 2) = "ze"
    strOne(30, 1) = "そ": strOne(30, 2) = "so"
    strOne(31, 1) = "ぞ": strOne(31, 2) = "zo"
    strOne(32, 1) = "た": strOne(32, 2) = "ta"
    strOne(33, 1) = "だ": strOne(33, 2) = "da"
    strOne(34, 1) = "ち": strOne(34, 2) = "chi"
    strOne(35, 1) = "ぢ": strOne(35, 2) = "di"
    strOne(36, 1) = "つ": strOne(36, 2) = "tsu"
    strOne(37, 1) = "づ": strOne(37, 2) = "du"
    strOne(38, 1) = "て": strOne(38, 2) = "te"
    strOne(39, 1) = "で": strOne(39, 2) = "de"
    strOne(40, 1) = "と": strOne(40, 2) = "to"
    strOne(41, 1) = "ど": strOne(41, 2) = "do"
    strOne(42, 1) = "な": strOne(42, 2) = "na"
    strOne(43, 1) = "に": strOne(43, 2) = "ni"
    strOne(44, 1) = "ぬ": strOne(44, 2) = "nu"
    strOne(45, 1) = "ね": strOne(45, 2) = "ne"
    strOne(46, 1) = "の": strOne(46, 2) = "no"
    strOne(47, 1) = "は": strOne(47, 2) = "ha"
    strOne(48, 1) = "ば": strOne(48, 2) = "ba"
    strOne(49, 1) = "ぱ": strOne(49, 2) = "pa"
    strOne(50, 1) = "ひ": strOne(50, 2) = "hi"
    strOne(51, 1) = "び": strOne(51, 2) = "bi"
    strOne(52, 1) = "ぴ": strOne(52, 2) = "pi"
    strOne(53, 1) = "ふ": strOne(53, 2) = "fu"
    strOne(54, 1) = "ぶ": strOne(54, 2) = "bu"
    strOne(55, 1) = "ぷ": strOne(55, 2) = "pu"
    strOne(56, 1) = "へ": strOne(56, 2) = "he"
    strOne(57, 1) = "べ": strOne(57, 2) = "be"
    strOne(58, 1) = "ぺ": strOne(58, 2) = "pe"
    strOne(59, 1) = "ほ": strOne(59, 2) = "ho"
    strOne(60, 1) = "ぼ": strOne(60, 2) = "bo"
    strOne(61, 1) = "ぽ": strOne(61, 2) = "po"
    strOne(62, 1) = "ま": strOne(62, 2) = "ma"
    strOne(63, 1) = "み": strOne(63, 2) = "mi"
    strOne(64, 1) = "む": strOne(64, 2) = "mu"
    strOne(65, 1) = "め": strOne(65, 2) = "me"
    strOne(66, 1) = "も": strOne(66, 2) = "mo"
    strOne(67, 1) = "ゃ": strOne(67, 2) = "xya"
    strOne(68, 1) = "や": strOne(68, 2) = "ya"
    strOne(69, 1) = "ゅ": strOne(69, 2) = "xyu"
    strOne(70, 1) = "ゆ": strOne(70, 2) = "yu"
    strOne(71, 1) = "ょ": strOne(71, 2) = "xyo"
    strOne(72, 1) = "よ": strOne(72, 2) = "yo"
    strOne(73, 1) = "ら": strOne(73, 2) = "ra"
    strOne(74, 1) = "り": strOne(74, 2) = "ri"
    strOne(75, 1) = "る": strOne(75, 2) = "ru"
    strOne(76, 1) = "れ": strOne(76, 2) = "re"
    strOne(77, 1) = "ろ": strOne(77, 2) = "ro"
    strOne(78, 1) = "わ": strOne(78, 2) = "wa"
    strOne(79, 1) = "ゐ": strOne(79, 2) = "wi"
    strOne(80, 1) = "ゑ": strOne(80, 2) = "we"
    strOne(81, 1) = "を": strOne(81, 2) = "wo"
    strOne(82, 1) = "ん": strOne(82, 2) = "n"
    strOne(83, 1) = "ゑ": strOne(83, 2) = "we"
    strOne(84, 1) = "を": strOne(84, 2) = "wo"
    strOne(85, 1) = "ん": strOne(85, 2) = "n"

End Sub


Private Sub test()
MsgBox RomajiConversion("ろーま")
MsgBox RomajiConversion("ハムレット")
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 バイナリモードで指定文字列から指定文字を抜き出す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function CharacterFind(ByVal Character As String, _
ByVal FirstStr As StringByVal LastStr As StringAs String
'****************************************************
'バイナリモードで指定文字列から指定文字を抜き出す
'****************************************************
'どちらか一方でも見つからない場合は=""を返します。
'引数LastStrの文字は、引数FirstStrの文字の後から探します。
'引数LastStrは引数FirstStrの文字の次の文字からの検索になります。
Dim i As Long, n As Long
i = InStr(1, Character, FirstStr, vbBinaryCompare)
If i = 0 Then CharacterFind = "": Exit Function
n = InStr(i, Character, LastStr, vbBinaryCompare)
If n = 0 Then CharacterFind = "": Exit Function
CharacterFind = Mid(Character, i, n + Len(LastStr) - i)
'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │A/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘
End Function


Private Sub test()
Dim a As String
a = "ちワあ  dい うえおちワkoんにちワお元気zですか"
'「ちワ」は3つ目をヒットさせます。
Debug.Print CharacterFind(a, "ko", "ちワ")
'koんにちワ
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 バイナリモードで指定文字列から指定文字を抜き出す(指定文字を除去)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function CharacterFindNext(ByVal Character As String, _
ByVal FirstStr As StringByVal LastStr As StringAs String
'*****************************************************************
'バイナリモードで指定文字列から指定文字を抜き出す(指定文字を除去)
'*****************************************************************
'どちらか一方でも見つからない場合は=""を返します。
'引数LastStrの文字は、引数FirstStrの文字の後から探します。
'引数LastStrは引数FirstStrの文字の次の文字からの検索になります。
'引数LastStrと引数FirstStrの文字は除きます。
Dim i As Long, n As Long
i = InStr(1, Character, FirstStr, vbBinaryCompare)
If i = 0 Then CharacterFindNext = "": Exit Function
n = InStr(i, Character, LastStr, vbBinaryCompare)
If n = 0 Then CharacterFindNext = "": Exit Function
CharacterFindNext = Mid(Character, i + Len(FirstStr), _
n + Len(LastStr) - (i + Len(FirstStr)) - Len(LastStr))
'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │A/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘
End Function


Private Sub test()
Dim a As String
a = "ちワYyあ  dい うえおちワXxzkoんにちワYyお元気zですか"
'「ちワ」は3つ目をヒットさせます。
Debug.Print CharacterFindNext(a, "Xxz", "Yy")
'koんにちワ
End Sub


 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 フリガナ変換・付ける・返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'*******************************************************************************
'フリガナ変換
'*******************************************************************************
  Me.TextBox7.Value = _
          StrConv(Application.GetPhonetic(Me.TextBox5.Value), vbHiragana)
End Sub

Private Sub フリガナを付ける()
'*******************************************************************************
'フリガナを付ける
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

'Set sht = ThisWorkbook.Worksheets("Sheet2")
Dim Xname As String
'***********************************
Xname = "給料_外注先.xls"
'***********************************
Set sht = Workbooks(Xname).Worksheets("Sheet1")

With sht
    b = Fnc最終行(sht)
    For a = 1 To b
        If a <> 1 Then
            For c = 2 To 2
                .Cells(a, c + 1).Value = Application.GetPhonetic(.Cells(a, c))
            Next c
        Else
            .Cells(a, 3).Value = "フリガナ"
        End If
    Next a
End With
End Sub

Public Function fncフリガナ(str As StringAs String
'*******************************************************************************
'フリガナを返す
'*******************************************************************************
      fncフリガナ = Application.GetPhonetic(str)
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 ファイル内文字付番置換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Option Explicit

Dim lngNo&

Sub ファイル内文字付番置換()
'***************************************************
'大量の同じ文字が記述されているファイルのその各同じ文字
'に番号を付ける
'***************************************************
FileReadingAndWriting ThisWorkbook.Path & "\参照雛形\index.txt", "vbサムネイル", "vbサムネイル"
End Sub

Private Sub FileReadingAndWriting(対象ファイル$, 検索字$, 置換字$)
'***************************************************
'大量の同じ文字が記述されているファイルのその各同じ文字
'に番号を付ける
'***************************************************
Dim RetrievalCharacter$, ConversionCharacter$
Dim OriginalFile$, ReproductionFile$
Dim WritingFile As Integer, ReadingFile As Integer
Dim strDAT$, lngCnt&

'パラメータ設定部----------------------------------------------------
'元のファイルフルパスとファイル名
OriginalFile = 対象ファイル
'コピーするファイルとファイル名
ReproductionFile = ThisWorkbook.Path & "\Copy" & Format(Date, "yymmdd") & Format(Time, "hhmmss") & ".txt"
'検索文字
RetrievalCharacter = 検索字
'置換文字
ConversionCharacter = 置換字
'--------------------------------------------------------------------

'エラーが発生した場合次のステートメントから実行継続
On Error Resume Next

'ファイルコピーの実行
FileCopy OriginalFile, ReproductionFile

'エラーが発生した場合
If Err <> 0 Then
    MsgBox "Error" & Err, vbCritical, "Error"
    Exit Sub
End If

'元のファイル削除
Kill OriginalFile

'使用可能なファイル番号取得
WritingFile = FreeFile()
Open ReproductionFile For Input As #WritingFile
  
'使用可能なファイル番号取得
ReadingFile = FreeFile()
Open OriginalFile For Output As #ReadingFile
 
'変数初期化
lngCnt = 0
'グローバル変数の初期化
lngNo = 0

Do Until EOF(WritingFile) '最後(全て)
    'ファイル読込
    Line Input #WritingFile, strDAT
    '置換実行(Function)---------------↓対象文字列------↓検索文字------↓置換文字
    lngCnt = lngCnt + FncstrReplace(strDAT, RetrievalCharacter, ConversionCharacter)
    'ファイルに挿入
    Print #ReadingFile, strDAT
Loop
 
'それぞれのファイルを閉じる
Close #WritingFile
Close #ReadingFile
 
'最初にコピーしたファイルを削除
Kill ReproductionFile

End Sub

Private Function FncstrReplace&(ByRef 対象文字列$, 検索文字$, 置換文字$)
'***********************************************************************
'大量の指定文字を検索し順番に番号を付ける
'***********************************************************************

Dim RetrievalResultPosition&, RetrievalBeginningNumber&
Dim ReplacementCharacterNumber&, ConversionCharacterNumber&
Dim strNO$
  
    '重複防止検索開始番号初期化
    RetrievalBeginningNumber = 1

    'パラメータ設定
        '置換え側[+ 3]は付ける番号の文字数又は桁数)
        ReplacementCharacterNumber = Len(置換文字) + 3
        '検索側
        ConversionCharacterNumber = Len(検索文字)
  
    Do
        '対象文字列の検索文字位置取得
        RetrievalResultPosition = InStr(RetrievalBeginningNumber, 対象文字列, 検索文字, vbBinaryCompare)
        '検索文字が[0]の場合
        If RetrievalResultPosition = 0 Then Exit Do
        
        FncstrReplace = FncstrReplace + 1
        
        'グローバル変数の値を増加
        lngNo = lngNo + 1
        
        '付加する番号を3桁にする
        strNO = Format(lngNo, "00#")
        
        '置換
        対象文字列 = Left$(対象文字列, RetrievalResultPosition - 1) & 置換文字 & strNO _
          & Right$(対象文字列, Len(対象文字列) - RetrievalResultPosition - ConversionCharacterNumber + 1)
        
        '重複検索を防止
        RetrievalBeginningNumber = RetrievalResultPosition + ReplacementCharacterNumber
    Loop
    
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

文字操作 ローカルパス[¥]をサーバ用パス[/]へ変更

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function PathSignChangeS(strPath As StringAs String
'*****************************************
'ローカルパス[\]をサーバ用パス[/]へ変更
'*****************************************

Dim cntLen As Long
Dim cntByt As Long

'文字列中に2byte文字が含まれているか判定
cntLen = Len(strPath)
cntByt = LenB(StrConv(strPath, vbFromUnicode))

If (cntLen <> cntByt) Then
    MsgBox "2byte文字が含まれています!", vbCritical, "PathSignChange"
    PathSignChangeS = ""
Else
    PathSignChangeS = Replace(strPath, "\", "/")
End If

End Function


Function PathSignChangeE(strPath As StringAs String
'*****************************************
'サーバ用パス[/]をローカルパス[\]へ変更
'*****************************************

Dim cntLen As Long
Dim cntByt As Long

'文字列中に2byte文字が含まれているか判定
cntLen = Len(strPath)
cntByt = LenB(StrConv(strPath, vbFromUnicode))

If (cntLen <> cntByt) Then
    MsgBox "2byte文字が含まれています!", vbCritical, "PathSignChange"
    PathSignChangeE = ""
Else
    PathSignChangeE = Replace(strPath, "/", "\")
End If

End Function


Private Sub testS()
    MsgBox PathSignChangeS("K\06\PR\exe\www\XXX")
End Sub

Private Sub testE()
    MsgBox PathSignChangeE("K/06\PR/exe/www/XXX")
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[文字操作]

変数 Enumステートメント列挙変数「列挙型」

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'列挙型 (Enum) を宣言します。
'
'構文
'
'[Public | PrivateEnum name
'
'membername [= constantexpression]
'
'membername [= constantexpression]

'. . .

'End Enum

'Enum ステートメントの構文は、次の指定項目から構成されます。
'
'指定項目
'Public
'Private
'name
'membername
'constantexpression
'
'解説
'
'列挙変数は、列挙型 (Enum) を用いて宣言する変数です。変数とパラメータのどちらも、列挙型で宣言できます。列挙型の要素は、Enum ステートメントにおいて指定された定数値に初期化されます。割り当てられた値は、実行時には変更できません。正の値でも、負の値でも設定できます。次は、列挙型の使用例です。

Enum SecurityLevel
    IllegalEntry = -1
    SecurityLevel1 = 0
    SecurityLevel2 = 1
End Enum

'Enum ステートメントは、モジュール レベルでのみ記述できます。列挙型 (Enum) が宣言されると、その列挙型を使って、変数、パラメータ、または列挙型を返すプロシージャを宣言できます。列挙型の名前は、モジュール名では修飾できません。クラス モジュール内のパブリックな列挙型 (Public Enum) は、クラスのメンバではありません。ただし、それらはタイプ ライブラリに書き込まれます。標準モジュールにおいて定義された列挙型 (Enum) は、タイプ ライブラリには書き込まれません。同じ名前のパブリックな列挙型 (Public Enum) は同じ名前空間を共有するので、このような列挙型は標準モジュールとクラス モジュールでは定義できません。異なる種類のライブラリの中の 2 つの列挙型 (Enum) に同じ名前が付けられていて、その要素が異なる場合、その型の変数への参照においてどちらの列挙型が使われるかは、その参照においてどちらの種類のライブラリが高い優先順位を持つかで決まります。
'
'列挙型 (Enum) は、With ブロックの対象としては使えません。

'Enum ステートメントの使用例

'次の例では、Enum ステートメントを使って、名前付き定数の集合を定義しています。ここで定義している定数は、データベースに対するデータ入力フォームをデザインする際に選択できる色です。

Public Enum InterfaceColors
    icMistyRose = &HE1E4FF
    icSlateGray = &H908070
    icDodgerBlue = &HFF901E
    icDeepSkyBlue = &HFFBF00
    icSpringGreen = &H7FFF00
    icForestGreen = &H228B22
    icGoldenrod = &H20A5DA
    icFirebrick = &H2222B2
End Enum

 

 

 

2000年01月01日[VBサンプルコード]:[変数]

配列 変数が配列変数かどうかを調べます

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub ExamineArrayVariable()
'***********************************
'変数が配列変数かどうかを調べます。
'***********************************

Dim Array1(1 To 5) As Integer, Array2, Array3
Array2 = Array(1, 2, 3)
Array3 = "4"
'IsArray 関数
MsgBox IsArray(Array1)
MsgBox IsArray(Array2)
MsgBox IsArray(Array3)

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

変数 Constステートメント型と値を一度で宣言

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Const ステートメント

リテラル値の代わりに使う定数を宣言します。

  • 構文

  • [Public | Private] Const constname [As type] = expression
  • Const ステートメントの構文は、次の指定項目から構成されます。
  • 指定項目 内容

  • Public
    省略可能です。すべてのモジュール内のすべてのプロシージャから参照可能な定数を宣言するために、モジュール レベルで使用するキーワードです。プロシージャ内では、指定できません。
  • Private
    省略可能です。宣言が行われたモジュール内のプロシージャからのみ参照できる定数を宣言するときに指定するキーワードです。モジュール レベルで使用します。プロシージャ内では指定できません。
  • constname
    必ず指定します。定義する定数の名前を指定します。変数の標準的な名前付け規則に従って指定します。
  • type
    省略可能です。定数のデータ型を指定します。バイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点型 (Single)、倍精度浮動小数点数型 (Double)、10 進数型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String)、またはバリアント型 (Variant) のいずれかを指定できます。宣言する各変数に対して、As type 節を個別に指定します。
    expression
    必ず指定します。リテラル値、その他の定数、Is を除く算術演算子や論理演算子を組み合わせた式を指定します。
  • 解説

  • 既定では、定数はプライベート
    になります。プロシージャ内では、定数は常にプライベート定数として扱われて、適用範囲 (スコープ) は変更できません。標準モジュールでは、モジュール レベル定数の既定の適用範囲をキーワード Public で変更できます。一方、クラス モジュールでは、定数はプライベート定数としてのみ使用でき、キーワード Public では適用範囲を変更できません。
  • 複数の定数宣言を 1 行にまとめるには
    、定数定義をカンマ (,) で区切ります。このようにして複数の定数を 1 行で宣言した場合、キーワード Public やキーワード Private を指定すると、すべての定数定義に対してキーワードが適用されます。
  • 定数に代入する式の中では、変数、ユーザー定義関数、Chr などの Visual Basic の組込み関数は、使えません。
  • メモ

  • 定数を使うと、プログラムがわかりやすく、修正も容易になります。変数とは異なり、定数はプログラムの実行中に値を変更できません。
  • As type で定数のデータ型を明示的に宣言しない場合、代入する式の評価結果に最適なデータ型が割り当てられます。
  • Sub プロシージャ、Function プロシージャ、または Property プロシージャ内で宣言した定数は、そのプロシージャ内でのみ参照できます。プロシージャの外で宣言された定数は、宣言されたモジュール内であれば、どこからでも参照できます。定数は、式が記述できる位置であれば、どこでも使えます。

Const ステートメントの使用例

次の例では、Const ステートメントを使って、リテラル値の代わりに使われる定数を宣言しています。パブリック (Public) 定数は、クラス モジュールではなく、標準モジュールの宣言セクションに記述します。プライベート (Private) 定数は、どの種類のモジュールの宣言セクションにも記述できます。
Option Explicit

'既定の設定では、定数はプライベート (Private) です。
    Const MyVar = 459

'パブリック (Public) 定数を宣言します。
    Public Const MyString = "HELP"

'プライベートの整数型 (Integer) 定数を宣言します。
    Private Const MyInt As Integer = 5

'1行で複数の定数を宣言します。
    Const MyStr = "Hello", MyDouble As Double = 3.4567

 

 

 

2000年01月01日[VBサンプルコード]:[変数]

配列 配列を使った変数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'◆通常の変数 Dim strTest As String
'
'◆配列変数 Dim strTest(5) As string
'strTest (0)
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'デフォルトでは添字は0(ゼロ)から始まる。
'
'◆モジュールの頭に、Option Base 1 宣言
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'
'◆部分的
'Dim strName(1 To 5) As String
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'
'※エクセルの場合、多くは1から始まるため、Option Base 1 を宣言した方が無難。
'
'◆2次元の場合
'※多次元の場合は、60次元までの配列を宣言可能することができます。
'Dim strTest(4, 4) As String
'strTest(0,0) から strTest(0,4) 小計5個
'strTest(1,0) から strTest(1,4) 小計5個
'strTest(2,0) から strTest(2,4) 小計5個
'strTest(3,0) から strTest(3,4) 小計5個
'strTest(4,0) から strTest(4,4) 小計5個
'合計25個

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列の同じ要素を削除するCollection

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub ArraySameElementDelCollection(ByVal DB As VariantByRef DB2() As String)
'*****************************************************
'配列 配列の同じ要素を削除するCollection
'*****************************************************

Dim cllArray As Collection, vrn As Variant, i As Long

Set cllArray = New Collection

On Error Resume Next
    For Each vrn In DB
        cllArray.Add vrn, vrn
    Next
On Error GoTo 0

ReDim DB2(cllArray.Count - 1)
    For i = 1 To cllArray.Count
        DB2(i - 1) = cllArray(i)
    Next

End Sub


Private Sub test()
Dim i As Long, x(5) As String, DB2() As String
'テストデータ
x(0) = "1"
x(1) = "A"
x(2) = "1"
x(3) = "B"
x(4) = ""
x(5) = "1"

Call ArraySameElementDelCollection(x, DB2())

'値を表示
    For i = LBound(DB2) To UBound(DB2)
        Debug.Print i & vbTab & DB2(i)
    Next i

'0   1
'1   A
'2   B
'3
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列作成

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


dim c
'合計41個の配列の場合(0から始まることに注意)
c = Array(76, 77, 78, 79, 80, 81, 83, 84, 86, 88, 90, 92, 94, 95, 96, 99, 100, 101, 104, 105, 106, 107, 108, 109, 111, 113, 115, 117, 129, 131, 132, 134, 136, 137, 139, 140, 142, 144, 145, 147, 744)
For b = 0 To 40
Me("TextBox" & c(b)).Value = ""
Next b

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'配列かどうかの検査 IsArray
'配列を作成 Array
'既定最少値の変更 Option Base
'配列の宣言および初期化 DimPrivatePublic, ReDimStatic
'配列サイズの限度の検査 LBound, UBound
'配列を再初期化 Erase, ReDim
'

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 Sortメソッド配列変数並替(文字列可・高速・2次元編)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub SortMethodArrayVariable2(ByRef strDataNew() As StringByVal strDataOld As Variant)
'****************************************************
'Sortメソッド配列変数並替(文字列可・高速・2次元編)
'****************************************************
'エクセルのRangeオブジェクト使用の為65536個を超えると不可。
'ここでは[Callステートメント]による呼び出しで関数化してます。
'既存シートデータに影響が無い様、新シートを使用してます。
'新シートは使用後削除されます。
'より高速にするにはシートを予め用意しておく事です。
'ByVal strDataOld で受け取った配列を
'ByRef strDataNew() で返してます。

Dim NewSheet As Worksheet
Dim ArrayMin(1) As Long
Dim ArrayMax(1) As Long

Dim i As Long, j As Long
Dim strDataOldDummy() As String 'Rangeオブジェクト用配列変数
Dim rngDummy As Range
'画面更新しない
Application.ScreenUpdating = False
'新シート追加及びセット
Set NewSheet = ThisWorkbook.Worksheets.Add

ArrayMin(0) = LBound(strDataOld, 1) '受け取った配列変数最小値
ArrayMax(0) = UBound(strDataOld, 1) '受け取った配列変数最大値
ArrayMin(1) = LBound(strDataOld, 2) '受け取った配列変数最小値
ArrayMax(1) = UBound(strDataOld, 2) '受け取った配列変数最大値

'①受け取った配列変数をRangeオブジェクト用に配列変数を定義
ReDim strDataOldDummy((ArrayMin(0) + 1) To (ArrayMax(0) + 1), _
(ArrayMin(1) + 1) To (ArrayMax(1) + 1))
'②返す配列変数の格納数を定義
ReDim strDataNew(ArrayMin(0) To ArrayMax(0), ArrayMin(1) To ArrayMax(1))

    '受け取った配列変数①をRangeオブジェクト用配列変数にコピー
    For i = ArrayMin(0) To ArrayMax(0)
        For j = ArrayMin(1) To ArrayMax(1)
            strDataOldDummy(i + 1, j + 1) = strDataOld(i, j)
        Next j
    Next i

    With NewSheet

        '③Rangeオブジェクトをセット
        Set rngDummy = .Range(.Cells(ArrayMin(0) + 1, 1), .Cells(ArrayMax(0) + 1, 2))
        'セットしたRangeオブジェクト③にRangeオブジェクト用配列変数①をコピー
        rngDummy = strDataOldDummy
        '③RangeオブジェクトSortメソッド(降順)
        rngDummy.Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlDescending
        '返す配列変数②に格納
        For i = ArrayMin(0) + 1 To ArrayMax(0) + 1
        For j = ArrayMin(1) + 1 To ArrayMax(1) + 1
            strDataNew(i - 1, j - 1) = rngDummy(i, j)
        Next j
        Next i
        '③セット解除
        Set rngDummy = Nothing

    End With
    'マクロの実行中に特定の警告やメッセージを表示しない
    Application.DisplayAlerts = False
    NewSheet.Delete '追加した新シート削除
    'マクロの実行中に特定の警告やメッセージを表示する
    Application.DisplayAlerts = True
    Set NewSheet = Nothing 'セット解除

Application.ScreenUpdating = True '画面更新する

'**************************
'重要引数群
'**************************

'Key1   並べ替えの最初に優先されるキーとなるフィールド。
'Order1 下記-Order-参照。
'Key2   並べ替えの 2 番目に優先されるキーとなるフィールド。
'Order2 下記-Order-参照。
'Key3   並べ替えの 3 番目に優先されるキーとなるフィールド。
'Order3 下記-Order-参照。
'1以外は多次元時(3次元まで)に使用。

'-Order-
'昇順に並べ替えるには、xlAscending を指定します(既定)
'降順に並べ替えるには、xlDescending を指定します。

'Header
'最初の行がタイトル行であるかどうかを指定。
'xlGuess-(自動判別)、xlNo-(タイトルなし(既定))、xlYes-(最初の行がタイトル行)

'MatchCase
'大文字と小文字を区別して並べ替えるには、True を指定。
'大文字と小文字を区別しないで並べ替えるには、False を指定。

End Sub


Private Sub test()
Dim strFile(5, 1) As String, str As String

strFile(0, 0) = "apple"
strFile(1, 0) = "apple"
strFile(2, 0) = "apple"
strFile(3, 0) = "windows"
strFile(4, 0) = "windows"
strFile(5, 0) = "windows"

strFile(0, 1) = "HD-x"
strFile(1, 1) = "HD-Y"
strFile(2, 1) = "HD-z"
strFile(3, 1) = "HD-A"
strFile(4, 1) = "HD-b"
strFile(5, 1) = "HD-c"

Dim strDataNew() As String

Call SortMethodArrayVariable2(strDataNew, strFile)

str = "(0, 0):(0, 1)" & vbTab & strDataNew(0, 0) & " | " _
& strDataNew(0, 1) & vbCr
str = str & "(1, 0):(1, 1)" & vbTab & strDataNew(1, 0) & " | " _
& strDataNew(1, 1) & vbCr
str = str & "(2, 0):(2, 1)" & vbTab & strDataNew(2, 0) & " | " _
& strDataNew(2, 1) & vbCr
str = str & "(3, 0):(3, 1)" & vbTab & strDataNew(3, 0) & " | " _
& strDataNew(3, 1) & vbCr
str = str & "(4, 0):(4, 1)" & vbTab & strDataNew(4, 0) & " | " _
& strDataNew(4, 1) & vbCr
str = str & "(5, 0):(5, 1)" & vbTab & strDataNew(5, 0) & " | " _
& strDataNew(5, 1) & vbCr

str = str & "合計数:" & vbTab & UBound(strDataNew, 1) + 1 & vbCr

MsgBox str
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

日付時刻 来月の第1日

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fnc来月の第1日(HIDUKE As DateAs String
'*******************************************************************************
'来月の第1日
'*******************************************************************************
fnc来月の第1日 = DateAdd("m", 1, DateSerial(Year(HIDUKE), Month(HIDUKE), 1))
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

配列 Sortメソッド配列変数並替(文字列可・高速・1次元編)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub SortMethodArrayVariable(ByRef strDataNew() As StringByVal strDataOld As Variant)
'****************************************************
'Sortメソッド配列変数並替(文字列可・高速・1次元編)
'****************************************************
'エクセルのRangeオブジェクト使用の為65536個を超えると不可。
'ここでは[Callステートメント]による呼び出しで関数化してます。
'既存シートデータに影響が無い様、新シートを使用してます。
'新シートは使用後削除されます。
'より高速にするにはシートを予め用意しておく事です。
'ByVal strDataOld で受け取った配列を
'ByRef strDataNew() で返してます。

Dim NewSheet As Worksheet
Dim ArrayMin As Long
Dim ArrayMax As Long

Dim i As Long
Dim strDataOldDummy() As String 'Rangeオブジェクト用配列変数
Dim rngDummy As Range
'画面更新しない
Application.ScreenUpdating = False
'新シート追加及びセット
Set NewSheet = ThisWorkbook.Worksheets.Add

ArrayMin = LBound(strDataOld) '受け取った配列変数最小値
ArrayMax = UBound(strDataOld) '受け取った配列変数最大値

'①受け取った配列変数をRangeオブジェクト用に配列変数を定義
ReDim strDataOldDummy((ArrayMin + 1) To (ArrayMax + 1), 0)
'②返す配列変数の格納数を定義
ReDim strDataNew(ArrayMin To ArrayMax)

    '受け取った配列変数①をRangeオブジェクト用配列変数にコピー
    For i = ArrayMin To ArrayMax
        strDataOldDummy(i + 1, 0) = strDataOld(i)
    Next i

    With NewSheet

        '③Rangeオブジェクトをセット
        Set rngDummy = .Range(.Cells(ArrayMin + 1, 1), .Cells(ArrayMax + 1, 1))
        'セットしたRangeオブジェクト③にRangeオブジェクト用配列変数①をコピー
        rngDummy = strDataOldDummy
        '③RangeオブジェクトSortメソッド(降順)
        rngDummy.Sort Key1:=.Cells(1, 1), Order1:=xlDescending
        '返す配列変数②に格納
        For i = ArrayMin + 1 To ArrayMax + 1
            strDataNew(i - 1) = rngDummy(i, 1)
        Next i
        '③セット解除
        Set rngDummy = Nothing

    End With
    'マクロの実行中に特定の警告やメッセージを表示しない
    Application.DisplayAlerts = False
    NewSheet.Delete '追加した新シート削除
    'マクロの実行中に特定の警告やメッセージを表示する
    Application.DisplayAlerts = True
    Set NewSheet = Nothing 'セット解除

Application.ScreenUpdating = True '画面更新する

'**************************
'重要引数群
'**************************

'Key1   並べ替えの最初に優先されるキーとなるフィールド。
'Order1 下記-Order-参照。
'Key2   並べ替えの 2 番目に優先されるキーとなるフィールド。
'Order2 下記-Order-参照。
'Key3   並べ替えの 3 番目に優先されるキーとなるフィールド。
'Order3 下記-Order-参照。
'1以外は多次元時(3次元まで)に使用。

'-Order-
'昇順に並べ替えるには、xlAscending を指定します(既定)
'降順に並べ替えるには、xlDescending を指定します。

'Header
'最初の行がタイトル行であるかどうかを指定。
'xlGuess-(自動判別)、xlNo-(タイトルなし(既定))、xlYes-(最初の行がタイトル行)

'MatchCase
'大文字と小文字を区別して並べ替えるには、True を指定。
'大文字と小文字を区別しないで並べ替えるには、False を指定。

End Sub


Private Sub test()
Dim strFile(5) As String

strFile(0) = "a"
strFile(1) = "b"
strFile(2) = "c"
strFile(3) = "d"
strFile(4) = "e"
strFile(5) = "f"

Dim strDataNew() As String

Call SortMethodArrayVariable(strDataNew, strFile)

MsgBox "最初は:" & strDataNew(LBound(strDataNew))
MsgBox "最後は:" & strDataNew(UBound(strDataNew))
MsgBox "合計数:" & UBound(strDataNew) + 1

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列の使い方

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

   
'配列を宣言すると、同じデータ型の 1 組の値を処理できます。通常の変数は、1 つの値を 1 つの区画に格納していますが、配列は、値を格納するために多くの区画を持つ 1 つの変数です。配列が格納しているすべての値を参照する場合は、配列全体を参照できます。また、配列の個々の要素を参照することもできます。
'
'たとえば、一年間の毎日の支出を記録する場合、365 個の変数を宣言する代わりに、365 の要素を持つ 1 つの配列変数を宣言することができます。配列の各要素には、1 つの値を持ちます。次のステートメントは、365 個の要素を持つ配列変数 curExpense を宣言します。特に指定しない限り、配列には 0 から始まるインデックス番号が付けられます。したがって、配列に指定するインデックスの最大値は、365 ではなく 364 となります。

Dim curExpense(364) As Currency

'各要素の値を設定するには、要素のインデックス番号を指定します。次の例は、配列の各要素に初期値 20 を代入します。

Sub FillArray()
    Dim curExpense(364) As Currency
    Dim intI As Integer
    For intI = 0 To 364
        curExpense(intI) = 20
    Next
End Sub

'インデックス番号の最小値の変更
'
'モジュールの先頭で Option Base ステートメントを使用すると、最初の要素の既定値を 0 から 1 に変更することができます。次の例では、Option Base ステートメントを使って、配列のインデックス番号の最小値を変更します。この Dim ステートメントは、365 の要素を持つ配列変数 curExpense を宣言します。

Option Base 1
Dim curExpense(365) As Currency

'次の例のように To 節を使って配列のインデックス番号の最小値を明示的に設定することもできます。

Dim curExpense(1 To 365) As Currency
Dim strWeekday(7 To 13) As String

'バリアント型 (Variant) の値の配列への格納
'
'バリアント型 (Variant) の値の配列を作成するには、次に示す 2 つの方法があります。1 つ目の方法は、次の例のようにバリアント型 (Variant) の配列を宣言する方法です。

Dim varData(3) As Variant
varData(0) = "Claudia Bendel"
varData(1) = "4242 Maple Blvd"
varData(2) = 38
varData(3) = Format("06-09-1952", "General Date")

'もう 1 つの方法は、次の例のように Array 関数で返される配列をバリアント型 (Variant) 変数に代入する方法です。

Dim varData As Variant
varData = Array("Ron Bendel", "4242 Maple Blvd", 38, _
Format("06-09-1952", "General Date"))

'どちらの方法で配列を作成しても、バリアント型 (Variant) の値の配列の要素を識別します。たとえば、次のステートメントは、前の 2 つの例のどちらにも追加できます。

MsgBox varData(0) & " に関するデータを記録しました。"

'多次元配列の使い方
'
'Visual Basic では、最大 60 次元までの配列を宣言することができます。たとえば次のステートメントは、2 次元の 5 x 10 の配列を宣言します。

Dim sngMulti(1 To 5, 1 To 10) As Single

'配列を行列とすると、最初の引数は行、2 番目の引数は列を表します。
'
'多次元の配列を処理するには、ネストさせた For...Next ステートメントを使います。次のプロシージャでは、単精度浮動小数点数型 (Single) の値を持つ 2 次元の配列を指定します。

Sub FillArrayMulti()
    Dim intI As Integer, intJ As Integer
    Dim sngMulti(1 To 5, 1 To 10) As Single
    
    ' 配列に値を格納します。
    For intI = 1 To 5
        For intJ = 1 To 10
            sngMulti(intI, intJ) = intI * intJ
            Debug.Print sngMulti(intI, intJ)
        Next intJ
    Next intI
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列のコピー

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Private Sub Test()

Dim i As Long
Dim 動的配列A()
Dim 動的配列B()
Dim 静的配列C(5)
Dim 静的配列D(0 To 5)

Dim テスト動的配列A()
Dim テスト動的配列B()
Dim テスト動的配列C()
Dim テスト動的配列D()

For i = 0 To 5
    ReDim Preserve 動的配列A(i)
    ReDim Preserve 動的配列B(i)
    動的配列A(i) = "A" & i
    動的配列B(i) = "B" & i
    静的配列C(i) = "C" & i
    静的配列D(i) = "D" & i
Next i

テスト動的配列A = 動的配列A
テスト動的配列B = 動的配列B
テスト動的配列C = 静的配列C
テスト動的配列D = 静的配列D

For i = LBound(テスト動的配列A) To UBound(テスト動的配列A)
    Debug.Print テスト動的配列A(i)
Next i
'A0
'A1
'A2
'A3
'A4
'A5
For i = LBound(テスト動的配列B) To UBound(テスト動的配列B)
    Debug.Print テスト動的配列B(i)
Next i
'B0
'B1
'B2
'B3
'B4
'B5
For i = LBound(テスト動的配列C) To UBound(テスト動的配列C)
    Debug.Print テスト動的配列C(i)
Next i
'C0
'C1
'C2
'C3
'C4
'C5
For i = LBound(テスト動的配列D) To UBound(テスト動的配列D)
    Debug.Print テスト動的配列D(i)
Next i
'D0
'D1
'D2
'D3
'D4
'D5

'コピー元配列の値を変更します。
For i = 0 To 5
    動的配列A(i) = "w" & i
    動的配列B(i) = "x" & i
    静的配列C(i) = "y" & i
    静的配列D(i) = "z" & i
Next i

For i = LBound(テスト動的配列A) To UBound(テスト動的配列A)
    Debug.Print テスト動的配列A(i)
Next i
'A0
'A1
'A2
'A3
'A4
'A5
'値は変わりません
'参照渡しではなく値渡しだからです。
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

配列 配列の指定された次元で使用できる添字の最小値を返す。

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub 配列の最小値()
'******************************************************
'配列の指定された次元で使用できる添字の最小値を返す。
'******************************************************

Dim Upper(4) As Long
Dim MyArray(1 To 10, 5 To 15, 10 To 20) ' 配列変数を宣言します。
Dim AnyArray(10)

Upper(1) = LBound(MyArray, 1)    '  1 が返ります。
Upper(2) = LBound(MyArray, 2)    '  5 が返ります。
Upper(3) = LBound(MyArray, 3)    ' 10 が返ります。
Upper(4) = LBound(AnyArray)      '  0 が返ります。

MsgBox Upper(1) & vbCr & Upper(2) & vbCr & Upper(3) & vbCr & Upper(4)
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[配列]

日付時刻 年齢を算出する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function GetAge(Birthday As String, Sanshutubi As StringAs Long
'引数[Birthday]:生年月日、String型でここにDate型に変換できないものが入ると「0」になる
'引数[Sanshutubi]:算出する該当日、String型でここにDate型に変換できないものが入ると「0」になる
'返値[GetAge]:Long

Dim a As Date, b As Date, C As Date

If IsDate(Birthday) = False Or IsDate(Sanshutubi) = False Then
    GetAge = 0
Else
    a = CDate(Birthday): b = CDate(Sanshutubi)
    C = DateSerial(Year(b), Month(a), Day(a))
    
        If C <= Date Then
            GetAge = Year(b) - Year(a)
        Else
            GetAge = Year(b) - Year(a) - 1
        End If
End If
End Function

Private Sub Test()
Dim a As String, b As String
a = InputBox("生年月日", "", "")
b = InputBox("算出する該当日", "", Date)
MsgBox GetAge(a, b)
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 日付/時刻表示書式指定文字の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


'(VB:Help)
'----------------------------------------------------
'yy/mm/dd               = 58/12/07
'mm -d                  = 12 - 7
'd -mmmm - yy           = 7 - December - 58
'd mmmm                 = 7 December
'mmmm yy                = December 58
'ddddd(aaa)             = 58/12/07(日)
'dddddd                 = 1958 年 12 月 7 日 日曜日
'ggge年m月d日(aaaa)     = 昭和33年12月7日(日曜日)
'hh:mm AM/PM            = 08:50 PM
'h:mm:ss a/p            = 8:50:35 p
'h:mm                   = 20:50
'h:mm:ss                = 20:50:35
'm/d/yy h:mm            = 12/7/58 20:50
'----------------------------------------------------
'****************************************************
'日付/時刻表示書式指定文字 (Format 関数)
'****************************************************

'c
'ddddd および t t t t t の書式で表した日付と時刻を、日付、時刻の順序で返します。
'指定された値に小数部がない場合は日付のみ、整数部がない場合は時刻のみを表す文字列を返します。
Private Sub testc()
    MsgBox Format(Now, "c")
    Debug.Print Format(Now, "c") '出力例[2009/09/18 15:19:58]
End Sub


'ddd
'曜日を英語 (省略形) で返します (Sun ~ Sat)。
Private Sub testddd()
    MsgBox Format(Now, "ddd")
    Debug.Print Format(Now, "ddd") '出力例[Fri]
End Sub


'aaa
'曜日を日本語 (省略形) で返します (日~土)。
Private Sub testaaa()
    MsgBox Format(Now, "aaa")
    Debug.Print Format(Now, "aaa") '出力例[金]
End Sub


'dddd
'曜日を英語で返します (Sunday ~ Saturday)。
Private Sub testdddd()
    MsgBox Format(Now, "dddd")
    Debug.Print Format(Now, "dddd") '出力例[Friday]
End Sub


'aaaa
'曜日を日本語で返します (日曜日~土曜日)。
Private Sub testaaaa()
    MsgBox Format(Now, "aaaa")
    Debug.Print Format(Now, "aaaa") '出力例[金曜日]
End Sub


'ddddd
'年、月、日を含む短い形式 (コントロール パネルで設定) で表した日付を返します。
'既定の短い日付形式は、m/d/yy です。
Private Sub testddddd()
    MsgBox Format(Now, "ddddd")
    Debug.Print Format(Now, "ddddd") '出力例[2009/09/18]
End Sub


'dddddd
'年、月、日を含む長い形式 (コントロール パネルで設定) で表した日付を返します。
'既定の長い日付形式は mmmm dd, yyyy です。
Private Sub testdddddd()
    MsgBox Format(Now, "dddddd")
    Debug.Print Format(Now, "dddddd") '出力例[2009年9月18日]
End Sub

'w
'曜日を表す数値を返します (日曜日が 1、土曜日が 7 となります)。
Private Sub testw()
    MsgBox Format(Now, "w")
    Debug.Print Format(Now, "w") '出力例[6]
End Sub


'ww
'その日が一年のうちで何週目に当たるかを表す数値を返します (1 ~ 54)。
Private Sub testww()
    MsgBox Format(Now, "ww")
    Debug.Print Format(Now, "ww") '出力例[38]
End Sub


'mmm
'月の名前を英語 (省略形) の文字列に変換して返します (Jan ~ Dec)。
Private Sub testmmm()
    MsgBox Format(Now, "mmm")
    Debug.Print Format(Now, "mmm") '出力例[Sep]
End Sub


'mmmm
'月の名前を英語で返します (January ~ December)。
Private Sub testmmmm()
    MsgBox Format(Now, "mmmm")
    Debug.Print Format(Now, "mmmm") '出力例[September]
End Sub

'oooo
'月の名前を日本語で返します (1 月 ~ 12 月)。
Private Sub testoooo()
    MsgBox Format(Now, "oooo")
    Debug.Print Format(Now, "oooo") '出力例[9月]
End Sub


'q
'1 年のうちで何番目の四半期に当たるかを表す数値を返します (1 ~ 4)。
Private Sub testq()
    MsgBox Format(Now, "q")
    Debug.Print Format(Now, "q") '出力例[3]
End Sub


'g
'年号の頭文字を返します (M、T、S、H)。
Private Sub testg()
    MsgBox Format(Now, "g")
    Debug.Print Format(Now, "g") '出力例[H]
End Sub


'gg
'年号の先頭の 1 文字を漢字で返します (明、大、昭、平)。
Private Sub testgg()
    MsgBox Format(Now, "gg")
    Debug.Print Format(Now, "gg") '出力例[平]
End Sub


'ggg
'年号を返します (明治、大正、昭和、平成)。
Private Sub testggg()
    MsgBox Format(Now, "ggg")
    Debug.Print Format(Now, "ggg") '出力例[平成]
End Sub


'e
'年号に基づく和暦の年を返します。1 桁の場合、先頭に 0 が付きません。
Private Sub teste()
    MsgBox Format(Now, "e")
    Debug.Print Format(Now, "e") '出力例[21]
End Sub

'EE
'年号に基づく和暦の年を 2 桁の数値を使って返します。1 桁の場合、先頭に 0 が付きます。
Private Sub testee()
    MsgBox Format("1991/09/18", "ee")
    Debug.Print Format("1991/09/18", "ee") '出力例[03]
End Sub


'y
'1 年のうちで何日目に当たるかを数値で返します (1 ~ 366)。
Private Sub testy()
    MsgBox Format("1991/09/18", "y")
    Debug.Print Format("1991/09/18", "y") '出力例[261]
End Sub

'yy
'西暦の年を下 2 桁の数値で返します (00 ~ 99)。
Private Sub testyy()
    MsgBox Format("1991/09/18", "yy")
    Debug.Print Format("1991/09/18", "yy") '出力例[91]
End Sub

'yyyy
'西暦の年を 4 桁の数値で返します (100 ~ 9999)。
Private Sub testyyyy()
    MsgBox Format("1991/09/18", "yyyy")
    Debug.Print Format("1991/09/18", "yyyy") '出力例[1991]
End Sub

'h
'時間を返します。1 桁の場合、先頭に 0 が付きません (0 ~ 23)。
Private Sub testh()
    MsgBox Format("2009/09/18 15:19:58", "h")
    Debug.Print Format("2009/09/18 15:19:58", "h") '出力例[15]
End Sub

'hh
'時間を返します。1 桁の場合、先頭に 0 が付きます (00 ~ 23)。
Private Sub testhh()
    MsgBox Format("2009/09/18 05:19:58", "hh")
    Debug.Print Format("2009/09/18 05:19:58", "hh") '出力例[05]
End Sub

'N
'分を返します。1 桁の場合、先頭に 0 が付きません (0 ~ 59)。
Private Sub testn()
    MsgBox Format("2009/09/18 05:19:58", "n")
    Debug.Print Format("2009/09/18 05:19:58", "n") '出力例[19]
End Sub

'nn
'分を返します。1 桁の場合、先頭に 0 が付きます (00 ~ 59)。
Private Sub testnn()
    MsgBox Format("2009/09/18 05:09:58", "nn")
    Debug.Print Format("2009/09/18 05:09:58", "nn") '出力例[09]
End Sub

's
'秒を返します。1 桁の場合、先頭に 0 が付きません (0 ~ 59)。
Private Sub tests()
    MsgBox Format("2009/09/18 05:09:58", "s")
    Debug.Print Format("2009/09/18 05:09:58", "s") '出力例[58]
End Sub

'ss
'秒を返します。1 桁の場合、先頭に 0 が付きます (00 ~ 59)。
Private Sub testss()
    MsgBox Format("2009/09/18 05:09:08", "ss")
    Debug.Print Format("2009/09/18 05:09:08", "ss") '出力例[08]
End Sub

'tttttt
'コントロール パネルで設定されている形式で時刻を返します。
'先頭に 0 を付けるオプションが選択されていて、時刻が午前または午後 10 時以前の場合、
'先頭に 0 が付きます。既定の形式は、h:mm:ss です。
Private Sub testtttt()
    MsgBox Format("2009/09/18 05:09:08", "ttttt")
    Debug.Print Format("2009/09/18 05:09:08", "ttttt") '出力例[5:09:08]
End Sub

'AM/PM
'時刻が正午以前の場合は大文字で AM を返し、正午~午後 11 時 59 分の間は大文字で PM を返します。
Private Sub testAMPM()
    MsgBox Format("2009/09/18 05:09:08", "AM/PM")
    Debug.Print Format("2009/09/18 05:09:08", "AM/PM") '出力例[AM]
End Sub

'am/pm
'時刻が正午以前の場合は小文字で am を返し、正午~午後 11 時 59 分の間は小文字で pm を返します。
Private Sub testAMPM2()
    MsgBox Format("2009/09/18 05:09:08", "am/pm")
    Debug.Print Format("2009/09/18 05:09:08", "am/pm") '出力例[am]
End Sub

'A/P
'時刻が正午以前の場合は大文字で A を返し、正午~午後 11 時 59 分の間は大文字で P を返します。
Private Sub testAP()
    MsgBox Format("2009/09/18 05:09:08", "A/P")
    Debug.Print Format("2009/09/18 05:09:08", "A/P") '出力例[A]
End Sub

'a/p
'時刻が正午以前の場合は小文字で a を返し、正午~午後 11 時 59 分の間は小文字で p を返します。
Private Sub testAP2()
    MsgBox Format("2009/09/18 05:09:08", "a/p")
    Debug.Print Format("2009/09/18 05:09:08", "a/p") '出力例[a]
End Sub

'AMPM
'"12 時間制" が選択されていて、時刻が正午以前の場合は午前を表すリテラル文字列を、
'正午~午後 11 時 59 分の間は午後を表すリテラル文字列を返します。
'これらの文字列の設定および "12 時間制" の選択は、コントロール パネルで行います。
'AMPM は大文字、小文字のどちらでも指定できます。既定の形式は、AM/PM です。
Private Sub testAMPM3()
    MsgBox Format("2009/09/18 05:09:08", "AMPM")
    Debug.Print Format("2009/09/18 05:09:08", "AMPM") '出力例[午前]
End Sub


'定義済み日付/時刻書式 (Format 関数)
'
'General Date
'日付または時刻、あるいはその両方を返します。整数部と小数部の両方を含む数値を指定すると、
'日付と時刻の両方を表す文字列 (たとえば 96/4/3 5:34) に変換します。小数部がない場合には日付のみ
'(たとえば 96/4/3)、整数部がない場合には時刻のみ (たとえば 5:34) を表す文字列に変換します。
'日付と時刻の表示形式はコントロール パネルの設定により決まります。
Private Sub testGeneralDate()
    MsgBox Format("2009/09/18 05:09:08", "General Date")
    Debug.Print Format("2009/09/18 05:09:08", "General Date") '出力例[2009/09/18 5:09:08]
End Sub

'Long Date
'日付の長い形式 (コントロール パネルの設定) で表した日付を返します。
Private Sub testLongDate()
    MsgBox Format("2009/09/18 05:09:08", "Long Date")
    Debug.Print Format("2009/09/18 05:09:08", "Long Date") '出力例[2009年9月18日]
End Sub

'Medium Date
'簡略形式で表した日付を返します。ホスト アプリケーションで使用されます。
Private Sub testMediumDate()
    MsgBox Format("2009/09/18 05:09:08", "Medium Date")
    Debug.Print Format("2009/09/18 05:09:08", "Medium Date") '出力例[09-09-18]
End Sub

'Short Date
'日付の短い形式 (コントロール パネルの設定) で表した日付を返します。
Private Sub testShortDate()
    MsgBox Format("2009/09/18 05:09:08", "Short Date")
    Debug.Print Format("2009/09/18 05:09:08", "Short Date") '出力例[2009/09/18]
End Sub

'Long Time
'時刻、分、秒を含む形式で表した時刻を返します。
Private Sub testLongTime()
    MsgBox Format("2009/09/18 05:09:08", "Long Time")
    Debug.Print Format("2009/09/18 05:09:08", "Long Time") '出力例[5:09:08]
End Sub

'Medium Time
'時間と分を 12 時間制で表した時刻を返します。同時に午前 (AM)、午後 (PM) も追加します。
Private Sub testMediumTime()
    MsgBox Format("2009/09/18 05:09:08", "Medium Time")
    Debug.Print Format("2009/09/18 05:09:08", "Medium Time") '出力例[05:09 午前]
End Sub

'Short Time
'時間と分を 24 時間制で表した時刻 (たとえば 17:45) を返します。
Private Sub testShortTime()
    MsgBox Format("2009/09/18 05:09:08", "Short Time")
    Debug.Print Format("2009/09/18 05:09:08", "Short Time") '出力例[05:09]
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 日付と時刻に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

┌─────────────┬─────┬─────┬─────┐
│種別                      │          │          │          │
├─────────────┼─────┼─────┼─────┤
│現在の日付または時間の取得│Date      │ Now      │ Time     │
│日付計算の実行            │DateAdd   │ DateDiff │ DatePart │
│日付の取得                │DateSerial│ DateValue│          │
│時間の取得                │TimeSerial│ TimeValue│          │
│現在の日付または時間の設定│Date      │ Time     │          │
│処理時間の計測            │Timer     │          │          │
└─────────────┴─────┴─────┴─────┘

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 実行中のマクロを指定の秒数(1/1000)停止Timer関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Timer 関数

午前 0 時 (真夜中) から経過した秒数を表す単精度浮動小数点数型 (Single) の値を返します。

  • 構文
  • Timer
  • 解説
  • Microsoft Windows では、Timer 関数は小数点以下の値も返します。Macintosh では、小数点以下の値は返されません。

Timer 関数の使用例

次の例は、Timer 関数を使って、プログラムの実行を中断します。この例では、DoEvents ステートメントを使って、プログラムが中断している間も他のプロセスを割り込みで処理できます。
Option Explicit


Sub TimerWait(PauseTime As Double)
'************************************
'指定した秒数の間マクロを止める
'************************************

Dim Start As Double

Start = Timer
    Do While Timer < Start + PauseTime
        DoEvents
    Loop

End Sub


Private Sub test()

Dim PauseTime As Double
Dim Start As Double
Dim Finish As Double
Dim TotalTime As Double

PauseTime = 0.1

    Start = Timer
        TimerWait PauseTime
    Finish = Timer
    TotalTime = Finish - Start
Debug.Print TotalTime
' 0.109000000000378

End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 実行中のマクロを指定の時刻まで停止WaitメソッドTimeValue関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub TimeWait(lngSecond As Long)
'************************************
'指定した秒数の間マクロを止める
'************************************

'引数 lngSecond には秒数を!
Dim newHour As String
Dim newMinute As String
Dim newSecond As String
Dim waitTime As Variant

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + lngSecond
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

End Sub


Private Sub test()
Debug.Print Now()
Call TimeWait(10)
Debug.Print Now()
'2010/01/09 17:22:16
'2010/01/09 17:22:26
End Sub

Wait メソッド

実行中のマクロを指定の時刻まで停止します。指定の時間に達した場合、True を返します。

重要 Wait メソッドは、Excel のすべての動作を停止させますが、印刷や再計算などのバックグラウンド処理は続行されます。
  • 構文
  • expression.Wait(Time)
  • expression
    必ず指定します。対象となる Application オブジェクトを表すオブジェクト式を指定します。
  • Time
    必ず指定します。バリアント型 (Variant) の値を使用します。マクロを再開する時刻を Excel の日付の書式で指定します。

Wait メソッドの使用例

次の使用例は、実行中のマクロを当日の午後 6 時 23 分まで停止します。
Option Explicit

Application.Wait "18:23:00"
次の使用例は、実行中のマクロを約 10 秒間停止します。
Option Explicit

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
次の使用例は、10 秒を過ぎるとメッセージを表示します。
Option Explicit

If Application.Wait(Now + TimeValue("0:00:10")) Then
    MsgBox "時間が過ぎました。"
End If

TimeValue 関数

時刻を表すバリアント型 (内部処理形式 Date の Variant) の値を返します。

  • 構文

  • TimeValue(time)
  • 引数

  • time
    は必ず指定します。引数 time には、通常 0:00:00 (12:00:00 AM) ~ 23:59:59 (11:59:59 PM) の範囲の時刻を表す文字列式を指定します。また、この範囲で時刻を表す任意の式を指定することもできます。引数 time に Null 値が含まれると、Null 値を返します。
  • 解説

  • 12 時間制または24 時間制のどちらを使って時刻を指定してもかまいません。たとえば、"2:24PM" と "14:24" は、両方とも有効な引数となります。
  • 引数 time が日付の値を含む場合、TimeValue 関数はその日付を戻り値に含めません。ただし、引数 time に正しくない値を指定したときには、エラーが発生します。

TimeValue 関数の使用例

次の例は、TimeValue 関数を使って、文字列を時刻に変換します。時刻リテラルを使って、バリアント型 (Variant) や日付型 (Date) の変数に時刻を直接代入することもできます。たとえば、MyTime = #4:35:17 PM# のように指定します。
Option Explicit

Dim MyTime
MyTime = TimeValue("4:35:17 PM")            ' 時刻を返します。

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 先月の第1日

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fnc先月の第1日(HIDUKE As DateAs String
'*******************************************************************************
'先月の第1日
'*******************************************************************************
fnc先月の第1日 = DateAdd("m", -1, DateSerial(Year(HIDUKE), Month(HIDUKE), 1))
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 定義済み日付/時刻書式Format関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

      

'次の表は、定義済み日付/時刻書式の名前とその内容を示します。
'
'書式名 内容
'General Date 日付または時刻、あるいはその両方を返します。整数部と小数部の両方を含む数値を指定すると、日付と時刻の両方を表す文字列 (たとえば 96/4/3 5:34) に変換します。小数部がない場合には日付のみ (たとえば 96/4/3)、整数部がない場合には時刻のみ (たとえば 5:34) を表す文字列に変換します。日付と時刻の表示形式はコントロール パネルの設定により決まります。
'Long Date 日付の長い形式 (コントロール パネルの設定) で表した日付を返します。
'Medium Date 簡略形式で表した日付を返します。ホスト アプリケーションで使用されます。
'Short Date 日付の短い形式 (コントロール パネルの設定) で表した日付を返します。
'Long Time 時刻、分、秒を含む形式で表した時刻を返します。
'Medium Time 時間と分を 12 時間制で表した時刻を返します。同時に午前 (AM)、午後 (PM) も追加します。
'Short Time 時間と分を 24 時間制で表した時刻 (たとえば 17:45) を返します。

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 文字型にした1000分の1秒(日付・時間・付加)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function TimerStr() As String
'**********************************************
'文字型にした1000分の1秒
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix

TimerStr = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

End Function


Private Sub test_TimerStr()
Dim i As Byte
For i = 1 To 10
    Debug.Print TimerStr
Next i
'031
'031
'031
'031
'031
'031
'031
'031
End Sub


Function TimerTimeStr() As String
'**********************************************
'文字型にした1000分の1秒(時間・付加)
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix
Dim sTimer As String
sTimer = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

TimerTimeStr = Format(Time, "hhmmss") & sTimer

End Function


Private Sub test_TimerTimeStr()
Dim i As Byte
For i = 1 To 10
    Debug.Print TimerTimeStr
Next i
'073830906
'073830906
'073830906
'073830906
'073830921
'073830921
'073830921
'073830921
End Sub


Function TimerDateTimeStr() As String
'**********************************************
'文字型にした1000分の1秒(日付・時間・付加)
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix
Dim sTimer As String
sTimer = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

TimerDateTimeStr = Format(Now, "yyyymmddhhmmss") & sTimer

End Function


Private Sub test_TimerDateTimeStr()
Dim i As Byte
For i = 1 To 10
    Debug.Print TimerDateTimeStr
Next i
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252078
'20100111074252078
End Sub


Private Sub test()
Debug.Print Date    'Date 関数
Debug.Print Time    'Time 関数
Debug.Print Timer   'Timer 関数
Debug.Print Now     'Now 関数
'2010/01/11
'7:26:04
' 26764.08
'2010/01/11 7:26:04
End Sub

Timer 関数

午前 0 時 (真夜中) から経過した秒数を表す単精度浮動小数点数型 (Single) の値を返します。

  • 構文

  • Timer
  • 解説

  • Microsoft Windows では、Timer 関数は小数点以下の値も返します。Macintosh では、小数点以下の値は返されません。
  • Timer 関数の使用例

  • 次の例は、Timer 関数を使って、プログラムの実行を中断します。この例では、DoEvents ステートメントを使って、プログラムが中断している間も他のプロセスを割り込みで処理できます。
Option Explicit


Private Sub test()
Dim PauseTime, Start, Finish, TotalTime, msg
msg = "[はい] をクリックすると、プログラムの実行が 5 秒間中断されます。"
If (MsgBox(msg, 4)) = vbYes Then
    PauseTime = 5                ' 中断時間を設定します。
    Start = Timer                ' 中断の開始時刻を設定します。
    Do While Timer < Start + PauseTime
        DoEvents                 ' 他のプロセスに制御を渡します。
    Loop
    Finish = Timer               ' 中断の終了時刻を設定します。
    TotalTime = Finish - Start   ' 実際の中断時間を計算します。
    MsgBox "実行を " & TotalTime & " 秒間中断しました。"
    Debug.Print TotalTime
Else
    End
End If
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 表示書式指定文字の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の表は、日付と時刻の表示書式の指定例を示します。ただし、国別情報が日本語/日本に設定されているものと仮定します。また、日付は 1958 年 12 月 7 日、時刻は午後 8 時 50 分 35 秒であるものと仮定します。最後の例は、日付と時刻の両方を対象としています。
'
'指定した書式 変換結果
'yy/mm/dd 58/12/07
'mm-d 12-7
'd-mmmm-yy 7-December-58
'd mmmm 7 December
'mmmm yy December 58
'ddddd(aaa) 58/12/07(日)
'dddddd 1958 年 12 月 7 日 日曜日
'ggge年m月d日(aaaa) 昭和33年12月7日(日曜日)
'hh:mm AM/PM 08:50 PM
'h:mm:ss a/p 8:50:35 p
'h:mm 20:50
'h:mm:ss 20:50:35
'm/d/yy h:mm 12/7/58 20:50

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 秒数や分数を時間や日付形式にするdd_hh:nn:ss

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Function MakeTimeDateA(dblTime As DoubleAs String
'**********************************************
'秒数や分数を時間や日付形式にするdd_hh:nn:ss
'**********************************************
'引数dblTimeが秒の場合
'dd hh:nn:ss 形式の場合

    Dim Inds As Integer, Frms As String
    Dim Indn As Integer, Frmn As String
    Dim Indh As Integer, Frmh As String
    Dim Indd As Integer, Frmd As String

    Inds = dblTime Mod 60                '秒
    Indn = Round(dblTime \ 60) Mod 60    '分
    Indh = Round(dblTime \ 3600) Mod 24  '時
    Indd = Round(dblTime \ 86400)        '日

    Frms = Format(Inds, "0#")
    Frmn = Format(Indn, "0#")
    Frmh = Format(Indh, "0#")
    Frmd = Format(Indd, "0#")

MakeTimeDateA = Frmd & " " & Frmh & ":" & Frmn & ":" & Frms

'Mod 演算子
'2 つの数値の除算を行い、その剰余を返します。
'
'構文
'
'result = number1 Mod number2
'
'Mod 演算子の構文は、次の指定項目から構成されます。
'
'指定項目   内容
'result     必ず指定    任意の数値変数を指定します。
'number1    必ず指定    任意の数式を指定します。
'number2    必ず指定    任意の数式を指定します。
End Function


Private Sub testA()
Debug.Print MakeTimeDateA(86401)
Debug.Print MakeTimeDateA(86000)
Debug.Print MakeTimeDateA(8)
Debug.Print MakeTimeDateA(800000)
'返値
'01 00:00:01
'00 23:53:20
'00 00:00:08
'09 06:13:20
End Sub


Function MakeTimeDateB(dblTime As DoubleAs String
'**********************************************
'秒数や分数を時間や日付形式にするhh:nn:ss
'**********************************************
'引数dblTimeが秒の場合
'hh:nn:ss 形式の場合

    Dim Inds As Integer, Frms As String
    Dim Indn As Integer, Frmn As String
    Dim Indh As Integer, Frmh As String

    Inds = dblTime Mod 60                '秒
    Indn = Round(dblTime \ 60) Mod 60    '分
    Indh = Round(dblTime \ 3600)         '時

    Frms = Format(Inds, "0#")
    Frmn = Format(Indn, "0#")
    Frmh = Format(Indh, "0#")

MakeTimeDateB = Frmh & ":" & Frmn & ":" & Frms

End Function


Private Sub testB()
Debug.Print MakeTimeDateB(86401)
Debug.Print MakeTimeDateB(86000)
Debug.Print MakeTimeDateB(8)
Debug.Print MakeTimeDateB(800000)
'返値
'24:00:01
'23:53:20
'00:00:08
'222:13:20
End Sub
解説

剰余演算子は、数式 number1 を数式 number2 で除算し、その余りを演算結果 result として返します。このとき浮動小数点数は整数に丸められます。たとえば、次に示す式では、変数 A (演算結果 result) の値は 5 になります。

A = 19 Mod 6.7

通常、演算結果 result のデータ型は、result の値が整数であるかどうかに関係なく、バイト型 (Byte)、整数型 (Integer)、または長整数型 (Long)、あるいは、内部処理形式がバイト型、整数型、または長整数型のバリアント型 (Variant) になります。小数部分はすべて切り捨てられます。ただし、一方または両方の式が Null 値のときは、演算結果 result も Null 値になります。Empty 値を持つ式は、0 として扱われます。

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 曜日や時間間隔・日付間隔の取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub 曜日Weekday()
'*******************************************************************************
'曜日【Weekday(Date)】Weekday 関数
'*******************************************************************************
'指定された日付の曜日を取得します。
    MsgBox Weekday(Date)
    MsgBox Weekday(Date + 1)
'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜
End Sub


Sub 曜日()
'*******************************************************************************
'曜日【WeekdayName(Weekday(Date), False)】WeekdayName 関数
'*******************************************************************************
'指定された曜日を表す文字列を返します。
    MsgBox WeekdayName(Weekday(Date), False)    '曜日あり
    MsgBox WeekdayName(Weekday(Date), True)     '曜日なし
'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜
End Sub


Sub 日付間隔()
'*******************************************************************************
'日付間隔【DateDiff("d", 開始日, 終了日)】DateDiff 関数
'*******************************************************************************
'指定された日付までの日数を取得します。
    Const 開始日 = "2000/01/01"
    Const 終了日 = "2000/12/31"
     MsgBox DateDiff("yyyy", 開始日, 終了日) & "年" & vbCr & _
            DateDiff("q", 開始日, 終了日) & "四半期" & vbCr & _
            DateDiff("M", 開始日, 終了日) & "月" & vbCr & _
            DateDiff("y", 開始日, 終了日) & "年間通算日" & vbCr & _
            DateDiff("d", 開始日, 終了日) & "日" & vbCr & _
            DateDiff("w", 開始日, 終了日) & "週日" & vbCr & _
            DateDiff("ww", 開始日, 終了日) & "週" & vbCr & _
            DateDiff("h", 開始日, 終了日) & "時" & vbCr & _
            DateDiff("n", 開始日, 終了日) & "分" & vbCr & _
            DateDiff("s", 開始日, 終了日) & "秒"
'設定値
'-----------------------------------------------------
'設定値 内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒

'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜

'定数               値 内容
'vbUseSystem        0 NLS API の設定値を使います。
'vbFirstJan1        1 (既定値)1月1日を含む週を年度の第1週として扱います。
'vbFirstFourDays    2 7日のうち少なくとも4日が新年度に含まれる週を年度の
'                     第1週として扱います。
'vbFirstFullWeek    3 全体が新年度に含まれる最初の週を年度の第1週として扱います。

End Sub


Sub 経過時間()
'*******************************************************************************
'経過時間【DatePart("h", Time)】DatePart 関数
'*******************************************************************************
'指定の日付や時間などが該当値からいくら経過したかを求めます。
    MsgBox "今月" & DatePart("w", Date) & "週経過"
    MsgBox "今年" & DatePart("y", Date) & "日経過"
    MsgBox "今月" & DatePart("d", Date) & "日経過"
    MsgBox "今日" & DatePart("h", Time) & "時間経過"
'設定値
'-----------------------------------------------------
'設定値 内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒

'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜

'定数               値 内容
'vbUseSystem        0 NLS API の設定値を使います。
'vbFirstJan1        1 (既定値)1月1日を含む週を年度の第1週として扱います。
'vbFirstFourDays    2 7日のうち少なくとも4日が新年度に含まれる週を年度の
'                     第1週として扱います。
'vbFirstFullWeek    3 全体が新年度に含まれる最初の週を年度の第1週として扱います。

End Sub


Sub 時間間隔()
'*******************************************************************************
'時間間隔【DateAdd("ww", 4, 起算日)】DateAdd 関数
'*******************************************************************************
'加算後の日付や時間を表示します。
    MsgBox "今日から4週間:後" & Format(DateAdd("ww", 4, Date), "yyyy年m月d日")
    MsgBox "今日から10日前:" & Format(DateAdd("d", -10, Date), "yyyy年m月d日")
    MsgBox "今から20分後:" & Format(DateAdd("n", 20, Time), "h時m分")
'設定値
'-----------------------------------------------------
'設定値 内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒
End Sub


Sub 文字列変換日付()
'*******************************************************************************
'文字列変換日付【DateValue(日付)】DateValue 関数
'*******************************************************************************
'文字列を日付に変換します。
    MsgBox DateValue("S13年12月30日")
End Sub


Sub 文字列変換時刻()
'*******************************************************************************
'文字列変換時刻【TimeValue(時刻)】TimeValue 関数
'*******************************************************************************
'文字列を時刻に変換します。
    MsgBox TimeValue("13時54分")
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 保存名を作成する現在年月日時刻を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Public Function 保存名作成() As String
'*******************************************************************************
'保存名を作成する現在年月日時刻を取得
'*******************************************************************************
    保存名作成 = Format(Now, "-yy年mm月dd日hh時mm分ss秒")
End Function

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

日付時刻 曜日を表す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Me("textbox" & 4).Value = WeekdayName(Weekday(Date, vbSunday))

 

 

 

2000年01月01日[VBサンプルコード]:[日付時刻]

変数 変数と定数に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


'値の代入 Let
'変数または定数の宣言 ConstDimPrivatePublicNewStatic
'プライベート モジュールの宣言 Option Private Module
'バリアント型に関する情報を取得 IsArray, IsDate, IsEmpty, IsError, IsMissing, IsNull, IsNumeric, IsObject, TypeName, VarType
'現在のオブジェクトの参照 Me
'変数の明示的な宣言を要求 Option Explicit
'既定のデータ型の設定 Deftype

 

 

 

2000年01月01日[VBサンプルコード]:[変数]

変数 重複しない乱数取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Private Sub 重複しない乱数取得()
'*************************************
'重複しない乱数取得
'英字を付加したい場合及び数値のみ対応
'数値の範囲指定可能
'任意作成数
'*************************************

Dim RNDADD() As String '←出来た格納変数(グローバル変数へ)

Dim 乱数最低値 As Long, 乱数最高値 As Long
Dim 作成数 As Long
Dim MyValue, a As Long, b As Long, i As Long

乱数最低値 = 1000000: 乱数最高値 = 9999999
作成数 = 10

'英字をつけない場合のエラー回避
If (乱数最高値 - 乱数最低値) + 1 < 作成数 Then
    MsgBox "作成範囲", 0, "ERROR"
Exit Sub
End If

For a = 1 To 作成数
    ReDim Preserve RNDADD(i)
再試行:
    MyValue = Int((乱数最高値 * Rnd) + 乱数最低値)
    '*英字を付加したい場合は↓を追加
    MyValue = ランダム英字取得 & ランダム英字取得 & ランダム英字取得 & MyValue
        For b = LBound(RNDADD) To UBound(RNDADD)
            '作成済みと重複していたら
            If RNDADD(b) = MyValue Then GoTo 再試行:
        Next b
    RNDADD(i) = MyValue
    MsgBox RNDADD(i) '確認用MSG(削除)

    i = i + 1
Next a

End Sub


Private Function ランダム英字取得() As String
'*********************************************
'ランダム英字取得関数
'*********************************************
Dim MyValue, str(26) As String
MyValue = Int((26 * Rnd) + 1)
    str(1) = "a":  str(9) = "i": str(17) = "q": str(25) = "y"
    str(2) = "b": str(10) = "j": str(18) = "r": str(26) = "z"
    str(3) = "c": str(11) = "k": str(19) = "s"
    str(4) = "d": str(12) = "l": str(20) = "t"
    str(5) = "e": str(13) = "m": str(21) = "u"
    str(6) = "f": str(14) = "n": str(22) = "v"
    str(7) = "g": str(15) = "o": str(23) = "w"
    str(8) = "h": str(16) = "p": str(24) = "x"
ランダム英字取得 = str(MyValue)
End Function


Private Sub test1()
    MsgBox ランダム英字取得
End Sub

 

 

 

2000年01月01日[VBサンプルコード]:[変数]

変数 変数だけでソート(並び替え)昇順降順

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Private Sub test()
'*************************************
'変数だけでソート(並び替え)昇順降順
'*************************************

Dim i As Byte, str As String
Dim testData() As Long
ReDim testData(10) As Long
testData(1) = 3
testData(2) = 7
testData(3) = 1
testData(4) = 9
testData(5) = 2
testData(6) = 5
testData(7) = 8
testData(8) = 4
testData(9) = 6
testData(10) = 0

VariableSortAsc testData
str = ""
For i = 1 To 10
str = str & i & vbTab & testData(i) & vbCr
Next i
MsgBox str

ReDim testData(10) As Long

testData(1) = 3
testData(2) = 7
testData(3) = 1
testData(4) = 9
testData(5) = 2
testData(6) = 5
testData(7) = 8
testData(8) = 4
testData(9) = 6
testData(10) = 0

VariableSortDes testData
str = ""
For i = 1 To 10
str = str & i & vbTab & testData(i) & vbCr
Next i
MsgBox str
End Sub


Sub