演習課題 (1) 27 Nov., '18 katakan2hiragana.xlsm は, 下図のように 4~8 行目の B 列に漢字で表記した氏名,C 列にカタカナで表記したヨミガナ,D 列にひらがなで表記したよみがなを表示させることを意図している. このシートは, セル範囲 "B4:B8"( 図の赤枠内 ) に, キーボードから漢字で氏名を入力すると C 列にカタカナのヨミガナが自動的に表示されるようになっている. セル範囲 "C4:C8" に表示されたヨミガナを読み取って, それをひらがなに変換し, セル範囲 "D4:D8"( 図の青枠内 ) に書き出すプログラムを作成しなさい. プロシージャ名は,katakan2Hiragana とする. あらかじめ, 左図の赤枠内に, 図のように 5 名の名前をキーボードから入力すること. 苗字と名前の間には半角の空白をはさむこと. キーボードを用いずに, 氏名を Copy & Paste で記入するとヨミガナは表示されないので不可.
演習課題 (1)- 解答 27 Nov., '18 Sub katakan2hiragana() Const NR As Integer = 5 Dim katakana As String Dim ir As Integer For ir = 1 To NR katakana = Cells(iR + 3, 3).Value Cells(iR + 3, 4).Value = _ StrConv(katakana, _ vbhiragana) Next ir
演習課題 (2) 27 Nov., '18 ブック dividestring.xls は "A 列 " の氏名と "B 列 " の住所から成る名簿である. 氏名は, すべて姓と名の間に半角の空白が挿入されている. また, 住所はすべて都道府県名から始まっている. これだけの情報を用いて, 氏名を姓と名に分けて, それぞれ同じ行の "C 列 " と "D 列 " に, また, 住所を都道府県とそれ以外に分けてそれぞれ同じ行の "E 列 " と "F 列 " に表示するプログラムを作りなさい. 以下を参考にすると良い. 1 氏名は,Len 関数で文字列の長さを知り,InStr 関数で空白の位置を知り, 姓は Left 関数, 名は Right 関数または Mid 関数で切り出せばよい.2 住所は, 都道府県名は必ず,3 文字か 4 文字であり, かつ,4 文字である場合はすべて 県 であることを利用する. すなわち,Mid 関数で住所の 4 文字目を切り出し, これが " 県 " であれば, 最初の 4 文字が 県名 となり, そうでなければ, 最初の 3 文字が 都道府県名 となる. データ数は不明であるが, 先頭行が 4 行目であることは既知として良い. プロシージャ名は,divideString とする. 以下省略
演習課題 (2)- 解答 27 Nov., '18 Sub dividestring() Dim nr As Integer, ir As Integer Dim name As String, address As String Dim IsPref As String Dim pos As Integer, Length As Integer nr = Range("A4").CurrentRegion.Rows.Count - 1 For ir = 1 To nr name = Cells(iR + 3, 1).Value pos = InStr(1, name, " ") Length = Len(name) Cells(iR + 3, 3).Value = Left(name, pos - 1) Cells(iR + 3, 4).Value = Right(name, Length - pos) address = Cells(iR + 3, 2).Value Length = Len(address) IsPref = Mid(address, 4, 1) If (IsPref = " 県 ") Then Cells(iR + 3, 5).Value = Left(address, 4) Cells(iR + 3, 6).Value = Right(address, Length - 4) Else Cells(iR + 3, 5).Value = Left(address, 3) Cells(iR + 3, 6).Value = Right(address, Length - 3) End If Next ir
演習課題 (3) 実数を受け取り, = log ( + 1) を返すユーザ定義関数を作成し,calcLog.xlsm のシートのセル範囲 "A2:A11" のの値に対して, 下図のように, セル範囲 "B2:B11"( 右下図の赤枠内 ) にの値を書き出すプログラムを作成しなさい. 対数の底はである. メインのプロシージャ名は calclog とする.
演習課題 (3)- 解答 Private Function f(byval x As Double) As Double f = Log(x + 1) End Function Sub calclog() Const NR As Integer = 10 Dim x As Double Dim y As Double Dim ir As Integer For ir = 1 To NR x = Cells(iR + 1, 1).Value y = f(x) Cells(iR + 1, 2).Value = y Next ir
演習課題 (4) trianglearea.xlsmには, 左下図のようにセル範囲 "A2:C11" に10 個の三角形の3 辺の長さ,, が記入されている. このとき, この三角形の面積 Sを計算するユーザ定義関数を作成して, 右下図のように, セル範囲 "D2:D11"( 右下図赤枠内 ) に, 小数点以下第 2 位まで書き出すプログラムを作成しなさい. ただし,,, が三角形を構成しないときは, 不可と記すこと. = + + /2のとき, = である. メインのプロシージャ名は,triangleAreaとする.
演習課題 (4)- 解答 1 Private Function area(byval a As Double, _ ByVal b As Double, _ ByVal c As Double) _ As Double Dim p As Double If ((a > b + c) Or (b > c + a) Or _ (c > a + b)) Then area = -1 Else p = 0.5 * (a + b + c) area = Sqr(p * (p - a) * (p - b) _ * (p - c)) End If End Function :
演習課題 (4)- 解答 2 Sub trianglearea() Const NR As Integer = 10 Dim ir As Integer Dim a As Double, b As Double, _ c As Double Dim s As Double For ir = 1 To NR a = Cells(iR + 1, 1).Value b = Cells(iR + 1, 2).Value c = Cells(iR + 1, 3).Value s = area(a, b, c) If (s < 0) Then Cells(iR + 1, 4).Value = " 不可 " Else Cells(iR + 1, 4).Value = _ Round(s, 2) End If Next ir
演習課題 (5) 右に示すような関数がある. このとき, 新しいブック selectcase.xlsm に対して, InputBox メソッドを用いての値を入力し, メッセージボックスに下記のようにの値を表示させるプログラムを作成しなさい. ただし,Double 型の変数 x を引数とし,Double 型の値を戻り値とするユーザ定義型の関数を作成するものとする. メインのプロシージャ名は, selectcase とする. y 1 x x x 2 1 1 ( x ( 1 (1 1) x 1) x)
演習課題 (5)- 解答 Private Function f(byval x As Double) As Double If (x <= -1) Then f = -x - 1 ElseIf (x <= 1) Then f = Sqr(1 - x * x) Else f = x - 1 End If End Function Sub selectcase() Dim x As Double, y As Double Dim str As String Do str = Application.InputBox( _ "x の値を入力してください.", "x の入力 ") Loop Until (IsNumeric(str)) x = Val(str) y = f(x) MsgBox "x=" & x & " のときの y の値は " & y & " です."
演習課題 (6) ブックcalcMath.xlsmには, 右に示すように,2 行目 ~11 行目に,A 列にの値が,B 列にの値が記されている. このとき,double 型の5つの変数 x, y, a, b, cを引数とし,a, b, cにそれぞれ, + /2および max(, ) を格納して戻すユーザ定義型のプロシージャを作成し, 結果を順にC~E 列に順に書き出すプログラムを作成しなさい. プロシージャの頭部は下のようになる. メインのプロシージャ名は,calcMathとする. Sub Calc(ByVal x As double, Byval y As Double, _ ByRef a As Double, ByRef b As Double, _ ByRef c As Double)
演習課題 (6)- 解答 Private Sub calc(byval x As Double, ByVal y As Double, _ ByRef a As Double, ByRef b As Double, _ ByRef c As Double) a = Sqr(x * y) b = (x + y) / 2 c = x If (c < y) Then c = y End If Sub calcmath() Const NR As Integer = 10 Dim ir As Integer Dim x As Double, y As Double Dim a As Double, b As Double, c As Double For ir = 1 To NR x = Cells(iR + 1, 1).Value y = Cells(iR + 1, 2).Value Call calc(x, y, a, b, c) Cells(iR + 1, 3).Value = a Cells(iR + 1, 4).Value = b Cells(iR + 1, 5).Value = c Next ir