エクセルVBAで作る 小規模用情報共有DBシステム ファイルアップロードも可能 テスト投稿
●演習シート用
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge <= 100 Then
If Target.Count > 1 Then Exit Sub
Dim t_address
Dim t_value
t_address = Target.Address(False, False)
t_value = Target.Value
'Target.Addressを条件にテーブルからwordを取り出す
'wordとTarget.Valueを比較し、合っていたら文字の色を青にする、以外は赤にする
'xxと入れたら答えを記入
If t_value = "" Then Exit Sub
Dim dic_obj_select_info As Object
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
Dim select_dto As Object
dic_obj_select_info.Add GB_PLACE, t_address
Set select_dto = select_info(GB_T_FILL_WORD_TABLE, dic_obj_select_info, fill_word_table_map)
' Debug.Print "DB" & select_dto.Item(GB_WORD)
' Debug.Print "セル" & select_dto.Item(GB_WORD)
If select_dto.Count > 0 Then
If t_value = select_dto.Item(1).Item(GB_WORD) Then
Range(t_address).Font.ColorIndex = 5
Range(t_address).Font.Bold = True
'xxと入力された場合は答えを出す。
ElseIf t_value = "xx" Or t_value = "ｘｘ" Then
Range(t_address).Value = select_dto.Item(1).Item(GB_WORD)
Range(t_address).Font.ColorIndex = 1
Range(t_address).Font.Bold = True
Else
Range(t_address).Font.ColorIndex = 3
Range(t_address).Font.Bold = True
End If
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
●edit_form用
Private Sub Label6_Click()
End Sub
Private Sub rate_ComboBox_Change()
End Sub
Private Sub regist_CommandButton_Click()
Call rgist_fill_question(2)
End Sub
Private Sub get_col_CommandButton_Click()
edit_Form.col_TextBox = ActiveCell.Column
End Sub
Private Sub get_row_CommandButton_Click()
edit_Form.row_TextBox.Value = ActiveCell.row
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub summary_TextBox_Change()
End Sub
Private Sub text_CommandButton_Click()
'---------------------temporary_tableからidを取得
Dim id As Long
Dim setter As Object
Dim getter As Object
Set setter = CreateObject("Scripting.Dictionary")
Set getter = CreateObject("Scripting.Dictionary")
setter.Add GB_T_ID, 1
Set getter = select_info(GB_T_TEMPORARY_TABLE, setter, temporary_table_map)
id = getter.Item(1).Item(GB_ID)
Set setter = Nothing
Set getter = Nothing
'---------------------law_info_tableのテキストページをフォームの値で更新する
Dim text_page As Long
Dim setter_target As Object
Dim setter_value As Object
Set setter_target = CreateObject("Scripting.Dictionary")
Set setter_value = CreateObject("Scripting.Dictionary")
text_page = Me.text_TextBox
setter_target.Add GB_ID, id
setter_value.Add GB_TEXT, text_page
Call update_info(GB_T_LAW_INFO_TABLE, setter_target, setter_value, law_info_table_map)
'---------------------temporary_tableのテキストページも更新
Set setter_target = Nothing
Set setter_target = CreateObject("Scripting.Dictionary")
setter_target.Add GB_T_ID, 1
Call update_info(GB_T_TEMPORARY_TABLE, setter_target, setter_value, temporary_table_map)
Set setter_target = Nothing
Set setter_value = Nothing
MsgBox "登録しました"
End Sub
Private Sub text_TextBox_Change()
End Sub
Private Sub UserForm_Initialize()
'
' 重要度の値をテンポラリーテーブルから取得
' Dim dic_obj_select_info As Object
' Dim select_dto As Object
' Dim t_rate As Object
'
' 検索条件の入れ物を用意
' Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
'
' dic_obj_select_info.Add GB_ID, 1
'
' select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map)
'
' t_rate = select_dto.Item(1).Item(GB_RATE)
'
With rate_ComboBox
.AddItem 1
.AddItem 2
.AddItem 3
End With
' If t_rate <> "" Then
'
' rate_ComboBox.ListIndex = t_rate
'
' Else
'
' rate_ComboBox.ListIndex = -1
'
'
' End If
'
End Sub
★edit_form用各ボタン名
licence_TextBox
category_TextBox
no_TextBox
get_row_CommandButton
row_TextBox
get_col_CommandButton
col_TextBox
rate_ComboBox
text_TextBox
text_CommandButton
regist_CommandButton
●fill_chara_Form用
Private Sub CommandButton1_Click()
End Sub
Private Sub create_fill_chara_Click()
Call create_fill_in_the_blank_character
End Sub
Private Sub regist_fill_chara_Click()
Dim last_row As Long
Dim last_col As Long
last_row = fill_chara_Form.last_row_text
last_col = fill_chara_Form.last_col_text
Call register_fill_in_the_blank_character(last_row, last_col)
End Sub
Private Sub delete_line_Button_Click()
Call delete_line
End Sub
Private Sub drow_line_Button_Click()
Call drow_line
End Sub
Private Sub drow_line_Button2_Click()
Call drow_line2
End Sub
Private Sub row_delete_Click()
Call row_delete_1
End Sub
Private Sub row_insert_Click()
Call row_insert_1
End Sub
★fill_chara_Form用各ボタン
row_insert
row_delete
drow_line_Button
drow_line_Button2
delete_line_Button
●index_Form
Private Sub CommandButton1_Click()
regist_Form.Show vbModeless
End Sub
Private Sub open_law_Form_Click()
law_Form.Show vbModeless
End Sub
Private Sub opne_fill_chara_form_Click()
fill_chara_Form.Show vbModeless
End Sub
Private Sub UserForm_Click()
End Sub
★index_Form用各ボタン
open_law_Form
opne_fill_chara_form
CommandButton1
●law_Form
'Private Sub CommandButton1_Click()
'
'
' Dim str As String
'
' str = UserForm1.TextBox1.Value
'
' '改行コードを削除
'
' str = Replace(str, vbCrLf, "")
'' Debug.Print str
'
'
'' Call get_kanji(str)
' Call decompose_string(str)
'
'End Sub
Private Sub CommandButton2_Click()
Call create_fill_in_the_blank_character
End Sub
Private Sub CommandButton3_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub law_CommandButton_Click()
Dim str As String
str = law_Form.law_TextBox.Value
' '改行コードを削除
' str = Replace(str, vbCrLf, "")
'
' Call decompose_string(str)
'
str = Replace(str, vbCrLf, "/")
Call decompose_string_direct(str)
End Sub
Private Sub law_TextBox_Change()
End Sub
Private Sub reset_Button_Click()
Call reset_question
End Sub
★law_Form用ボタン
reset_Button
law_CommandButton
●regist_Form
Private Sub category_ComboBox_Change()
End Sub
Private Sub get_col_CommandButton_Click()
regist_Form.col_TextBox = ActiveCell.Column
End Sub
Private Sub get_row_CommandButton_Click()
regist_Form.row_TextBox.Value = ActiveCell.row
End Sub
Private Sub Label9_Click()
End Sub
Private Sub rate_ComboBox_Change()
End Sub
Private Sub summary_TextBox_Change()
End Sub
Private Sub UserForm_Initialize()
With licence_ComboBox
.AddItem "消防4類乙"
End With
licence_ComboBox.ListIndex = 0
With category_ComboBox
.AddItem "暗記"
End With
category_ComboBox.ListIndex = 0
With rate_ComboBox
.AddItem 1
.AddItem 2
.AddItem 3
End With
rate_ComboBox.ListIndex = 0
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub regist_CommandButton_Click()
If regist_Form.no_TextBox = "" Then
MsgBox "NOが指定されていません"
End
End If
Call rgist_fill_question(1)
End Sub
Private Sub UserForm_Click()
End Sub
★regist_Form用ボタン
licence_ComboBox
category_ComboBox
no_TextBox
get_row_CommandButton
row_TextBox
get_col_CommandButton
col_TextBox
rate_ComboBox
regist_CommandButton
●DB用
Option Explicit
Enum law_info_table
id = 1
licence
category
num
row
col
t_rate
t_summary
del_flg
t_text
t_text_name
times
sub_category
End Enum
Enum fill_word_table
id = 1
place
word
End Enum
Enum temporary_table
t_id = 1
id
licence
category
num
row
col
t_rate
t_summary
t_text
End Enum
Enum number_table
t_id = 1
number1
number2
number3
End Enum
Enum question_cycle_table
t_id = 1
license
sub_category
times
End Enum
Function select_info(table_name As String, ByVal select_dto As Object, table_map As Object) As Object
'情報の曖昧検索をする関数
'引数1：検索するテーブル名
'引数2：検索条件
'引数3：検索対象テーブルのマッピング情報
Dim tbList As ListObject
Dim record_count As Long
Dim i As Long
Dim j As Long
Dim dicKey_select As Variant
Dim serch_count As Long
Dim record As String
Dim search_Word As String
serch_count = 0
' Dim dicItem_select As Variant
Dim dicKey_table As Variant
dicKey_select = select_dto.keys
' dicItem_select = select_dto.items
dicKey_table = table_map.keys
'検索結果返却用
Dim dic_obj_result As Object
Set dic_obj_result = CreateDictionary
' Worksheets(table_name).Activate
Set tbList = CreateTableList(table_name)
'Set tbList = Worksheets(table_name).ListObjects(table_name)
record_count = tbList.ListRows.Count
With ThisWorkbook.Worksheets(table_name)
For i = 2 To record_count + 1
For j = 0 To UBound(dicKey_select)
'テーブルの検索対象情報
'todo 検索語に関しては前段階で小文字に変換できないか考える
'dictoinaryのキーの配列はすでに持ってるのだから、開けて変換して戻すくらいはできるはず
search_Word = ""
record = ""
search_Word = select_dto.Item(dicKey_select(j))
search_Word = StrConv(LCase(search_Word), vbNarrow)
'search_Word = Replace(search_Word, " ", "*")
record = .Cells(i, table_map.Item(dicKey_select(j))).Value
record = StrConv(LCase(record), vbNarrow)
' If Not record Like "*" & search_Word & "*" Then
'
' GoTo Skip
'
' End If
If Not record Like search_Word Then
GoTo Skip
End If
' If .Cells(i, table_map.Item(dicKey_select(j))).Value <> select_dto.Item(dicKey_select(j)) Then
'
' GoTo Skip
'
' End If
Next j
'子ディクショナリ
Dim c_dic_obj_result As Object
Set c_dic_obj_result = CreateDictionary
serch_count = serch_count + 1
'ここに来れたなら、条件がすべて一致しているはず。
For j = 0 To UBound(dicKey_table)
'テーブルの目的の行を追加する
c_dic_obj_result.Add dicKey_table(j), .Cells(i, table_map.Item(dicKey_table(j))).Value
Next j
'親ディクショナリに子ディクショナリを追加
dic_obj_result.Add serch_count, c_dic_obj_result
'for文を抜ける
' Exit For
Skip:
Next i
End With
Set select_info = dic_obj_result
End Function
Function insert_info(table_name As String, ByVal insert_dto As Object, table_map As Object)
'情報の登録を行う関数
'引数1：登録を行テーブル名
'引数2：登録内容
'引数3：登録テーブルのマッピング情報
Dim dicKey_table As Variant
Dim dicKey_insert As Variant
Dim i As Long
Dim tbList As ListObject
Set tbList = Worksheets(table_name).ListObjects(table_name)
dicKey_insert = insert_dto.keys
dicKey_table = table_map.keys
With tbList.ListRows.Add
For i = 0 To UBound(dicKey_insert)
.Range(table_map.Item(dicKey_insert(i))).Value = insert_dto(dicKey_insert(i))
Next i
End With
End Function
Function update_info(table_name As String, ByVal search_dto, ByVal update_dto As Object, table_map As Object)
'情報を更新する関数 検索条件は複数可能
'引数1：更新を行テーブル名
'引数2：更新を行うレコードの条件（ID=１）とか
'引数2：更新内容
'引数3：更新テーブルのマップ
Dim record_count As Long
Dim dicKey_serch As Variant
Dim dicKey_update As Variant
Dim dicKey_table As Variant
Dim tbList As ListObject
Set tbList = Worksheets(table_name).ListObjects(table_name)
Dim i As Long
Dim j As Long
record_count = tbList.ListRows.Count
dicKey_serch = search_dto.keys
dicKey_update = update_dto.keys
dicKey_table = table_map.keys
With Worksheets(table_name)
For i = 2 To record_count + 1
For j = 0 To UBound(dicKey_serch)
If .Cells(i, table_map.Item(dicKey_serch(j))).Value <> search_dto.Item(dicKey_serch(j)) Then
GoTo Skip
End If
Next j
'ここに来れたなら、条件がすべて一致しているはず。
For j = 0 To UBound(dicKey_update)
.Cells(i, table_map.Item(dicKey_update(j))).Value = update_dto.Item(dicKey_update(j))
Next j
Skip:
Next i
End With
End Function
Function law_info_table_map() As Object
'テーブル内でのカラムの位置をマッピングするやーつ
'このカラム名称だと1列目とか～
Dim dic_obj_law_info_table As Object
Set dic_obj_law_info_table = CreateObject("Scripting.Dictionary")
dic_obj_law_info_table.Add GB_ID, law_info_table.id
dic_obj_law_info_table.Add GB_LICENCE, law_info_table.licence
dic_obj_law_info_table.Add GB_CATEGORY, law_info_table.category
dic_obj_law_info_table.Add GB_NUM, law_info_table.num
dic_obj_law_info_table.Add GB_ROW, law_info_table.row
dic_obj_law_info_table.Add GB_COL, law_info_table.col
dic_obj_law_info_table.Add GB_RATE, law_info_table.t_rate
dic_obj_law_info_table.Add GB_SUMMARY, law_info_table.t_summary
dic_obj_law_info_table.Add GB_DEL_FLG, law_info_table.del_flg
dic_obj_law_info_table.Add GB_TEXT, law_info_table.t_text
dic_obj_law_info_table.Add GB_C_TEXT_NAME, law_info_table.t_text_name
dic_obj_law_info_table.Add GB_C_TIMES, law_info_table.times
dic_obj_law_info_table.Add GB_C_SUB_CATEGORY, law_info_table.sub_category
Set law_info_table_map = dic_obj_law_info_table
End Function
Function fill_word_table_map() As Object
Dim dic_obj_fill_word_table As Object
Set dic_obj_fill_word_table = CreateObject("Scripting.Dictionary")
dic_obj_fill_word_table.Add GB_ID, fill_word_table.id
dic_obj_fill_word_table.Add GB_PLACE, fill_word_table.place
dic_obj_fill_word_table.Add GB_WORD, fill_word_table.word
Set fill_word_table_map = dic_obj_fill_word_table
End Function
Function temporary_table_map() As Object
Dim dic_obj_temporary_table As Object
Set dic_obj_temporary_table = CreateObject("Scripting.Dictionary")
dic_obj_temporary_table.Add GB_T_ID, temporary_table.t_id
dic_obj_temporary_table.Add GB_ID, temporary_table.id
dic_obj_temporary_table.Add GB_LICENCE, temporary_table.licence
dic_obj_temporary_table.Add GB_CATEGORY, temporary_table.category
dic_obj_temporary_table.Add GB_NUM, temporary_table.num
dic_obj_temporary_table.Add GB_ROW, temporary_table.row
dic_obj_temporary_table.Add GB_COL, temporary_table.col
dic_obj_temporary_table.Add GB_RATE, temporary_table.t_rate
dic_obj_temporary_table.Add GB_SUMMARY, temporary_table.t_summary
dic_obj_temporary_table.Add GB_TEXT, temporary_table.t_text
Set temporary_table_map = dic_obj_temporary_table
End Function
Function number_table_map() As Object
Dim dic_obj_temporary_table As Object
Set dic_obj_temporary_table = CreateObject("Scripting.Dictionary")
dic_obj_temporary_table.Add GB_T_ID, number_table.t_id
dic_obj_temporary_table.Add GB_NUMBER1, number_table.number1
dic_obj_temporary_table.Add GB_NUMBER2, number_table.number2
dic_obj_temporary_table.Add GB_NUMBER3, number_table.number3
Set number_table_map = dic_obj_temporary_table
End Function
Function question_cycle_table_map() As Object
Dim dic_obj As Object
Set dic_obj = CreateDictionary
dic_obj.Add GB_ID, question_cycle_table.t_id
dic_obj.Add GB_LICENCE, question_cycle_table.license
dic_obj.Add GB_C_SUB_CATEGORY, question_cycle_table.sub_category
dic_obj.Add GB_C_TIMES, question_cycle_table.times
Set question_cycle_table_map = dic_obj
End Function
●common_function
Option Explicit
Function CreateDictionary() As Object
'ディクショナリーオブジェクトを作成して返却する関数
Dim dicObj As Object
Set dicObj = CreateObject("Scripting.Dictionary")
Set CreateDictionary = dicObj
End Function
Function CreateTableList(tableName As String) As Object
Dim tableList As ListObject
Set tableList = ThisWorkbook.Worksheets(tableName).ListObjects(tableName)
Set CreateTableList = tableList
End Function
●module1
Option Explicit
'law_info_table
Public Const GB_ID = "ID"
Public Const GB_LICENCE = "licence"
Public Const GB_CATEGORY = "category"
Public Const GB_NUM = "num"
Public Const GB_ROW = "row"
Public Const GB_COL = "col"
Public Const GB_RATE = "rate"
Public Const GB_SUMMARY = "summary"
Public Const GB_DEL_FLG = "del_flg"
Public Const GB_TEXT = "text"
Public Const GB_C_TEXT_NAME = "text_name"
Public Const GB_C_TIMES = "times"
Public Const GB_C_SUB_CATEGORY = "sub_category"
Public Const GB_PLACE = "place"
Public Const GB_WORD = "word"
Public Const GB_T_ID = "t_ID"
Public Const GB_TABLE = "table"
Public Const GB_NUMBER1 = "number1"
Public Const GB_NUMBER2 = "number2"
Public Const GB_NUMBER3 = "number3"
'question_cycle_table
Public Const GB_C_ID = "ID"
Public Const GB_C_SUBJECTS = "subjects"
'Public Const GB_C_CATEGORY = "category"
'Public Const GB_C_TIMES = "times"
Public Const GB_T_LAW_INFO_TABLE = "law_info_table"
Public Const GB_T_FILL_WORD_TABLE = "fill_word_table"
Public Const GB_T_TEMPORARY_TABLE = "temporary_table"
Public Const GB_T_NUMBER_TABLE = "number_table"
Public Const GB_T_QUESTION_CYCLE_TABLE = "question_cycle_table"
Sub create_fill_in_the_blank_character()
'選択した文字列を穴埋め形式にする(文字列を[]で囲む)
'[]で囲まれた文字が穴埋め文字列となり、呼び出されたときに解釈される
Dim rng As Range
Set rng = Selection
' Debug.Print (c.Value)
Dim i As Long
Dim str As Variant
Application.DisplayAlerts = False
For i = 1 To rng.Count
str = str & rng.Item(i)
Next i
'①一列挿入
Range(rng.Item(1).Address(False, False)).Insert shift:=xlShiftToRight
'Debug.Print rng.Item(1).Address(False, False)
'②①で挿入した列に識別文字を挿入
Range(Range(rng.Item(1).Address(False, False)).Offset(0, -1).Address(False, False)).Value = "["
Range(Range(rng.Item(rng.Count).Address(False, False)).Offset(0, 1).Address(False, False)).Insert shift:=xlShiftToRight
Range(Range(rng.Item(rng.Count).Address(False, False)).Offset(0, 1).Address(False, False)).Value = "]"
'Debug.Print rng.Item(rng.Count).Address(False, False)
'以下マージを行う
' Range(rng.Item(1).Address(False, False) & ":" & rng.Item(rng.Count).Address(False, False)).Merge
'
' Range(rng.Item(1).Address(False, False)).Value = str
Application.DisplayAlerts = True
End Sub
Sub row_insert_1()
'選択したセルに一列追加
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Selection
Dim i As Long
For i = 1 To rng.Count
' Debug.Print i & ":" & rng.Item(i).Address(False, False)
Range(rng.Item(i).Address(False, False)).Insert shift:=xlShiftToRight
Next i
Application.ScreenUpdating = True
End Sub
Sub row_delete_1()
'選択したセルを1列削除
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Selection
Dim i As Long
' For i = 1 To rng.Count
'
' Debug.Print i & ":" & rng.Item(i).Address(False, False)
'
' Range(rng.Item(i).Address(False, False)).Delete (xlShiftToLeft)
'
' Next i
'減少カウンタを使う理由
'https://teratail.com/questions/75463
For i = rng.Count To 1 Step -1
Range(rng.Item(i).Address(False, False)).Delete (xlShiftToLeft)
Next i
Application.ScreenUpdating = True
End Sub
Sub drow_line()
'選択したセルの外側に罫線を引く
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Selection
Dim bs As Border
Set bs = rng.Borders(xlEdgeTop)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeBottom)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeLeft)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeRight)
bs.LineStyle = xlContinuous
End Sub
Sub drow_line2()
'選択したセルの外側に罫線を引く
'水平線も引く
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Selection
Dim bs As Border
Set bs = rng.Borders(xlEdgeTop)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeBottom)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeLeft)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlEdgeRight)
bs.LineStyle = xlContinuous
Set bs = rng.Borders(xlInsideHorizontal)
bs.LineStyle = xlContinuous
End Sub
Sub delete_line()
'選択したセルの罫線を削除する
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Selection
rng.Borders.LineStyle = xlLineStyleNone
End Sub
Function rgist_fill_question(mode As Long)
'mode1:通常登録
'mode2:編集登録存在チェックを行わない
Dim newBookName As String
Dim savepath As String
Dim newBook As Workbook
Dim sheetname As String
Dim id As Long
Dim licence_chara As String
Dim category_chara As String
Dim no_chara As String
Dim row As Long
Dim col As Long
Dim t_rate As Long
Dim summary As String
Dim dic_obj_select_info As Object
Dim select_dto As Object
Dim tbList As ListObject
If mode = 1 Then
licence_chara = regist_Form.licence_ComboBox.Value
category_chara = regist_Form.category_ComboBox.Value
no_chara = regist_Form.no_TextBox
row = regist_Form.row_TextBox
col = regist_Form.col_TextBox
sheetname = licence_chara & "_" & category_chara & "_" & no_chara
t_rate = regist_Form.rate_ComboBox.ListIndex
summary = regist_Form.summary_TextBox
'-------------情報登録-------------
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
'存在チェックを行う
dic_obj_select_info.Add GB_LICENCE, licence_chara
dic_obj_select_info.Add GB_CATEGORY, category_chara
dic_obj_select_info.Add GB_NUM, no_chara
' dic_obj_select_info.Add GB_RATE, t_rate
' dic_obj_search_info.Add GB_SUMMARY, summary
Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map)
If select_dto.Count > 0 Then
MsgBox "登録済みの問題です。"
End
End If
'情報登録を行う
Dim dic_obj_insert_info As Object
Set dic_obj_insert_info = CreateObject("Scripting.Dictionary")
Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE)
dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1
dic_obj_insert_info.Add GB_LICENCE, licence_chara
dic_obj_insert_info.Add GB_CATEGORY, category_chara
dic_obj_insert_info.Add GB_NUM, no_chara
dic_obj_insert_info.Add GB_ROW, row
dic_obj_insert_info.Add GB_COL, col
dic_obj_insert_info.Add GB_RATE, t_rate
dic_obj_insert_info.Add GB_SUMMARY, summary
dic_obj_insert_info.Add GB_DEL_FLG, 0
Call insert_info(GB_T_LAW_INFO_TABLE, dic_obj_insert_info, law_info_table_map)
End If
If mode = 2 Then
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
'テンポラリーテーブルから更新用のIDを取得
dic_obj_select_info.Add GB_T_ID, 1
Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map)
id = select_dto.Item(1).Item(GB_ID)
licence_chara = select_dto.Item(1).Item(GB_LICENCE)
category_chara = select_dto.Item(1).Item(GB_CATEGORY)
no_chara = select_dto.Item(1).Item(GB_NUM)
sheetname = licence_chara & "_" & category_chara & "_" & no_chara
t_rate = edit_Form.rate_ComboBox.ListIndex
summary = edit_Form.summary_TextBox
'行列の更新を行う
row = edit_Form.row_TextBox
col = edit_Form.col_TextBox
'更新条件用の入れ物を用意
Dim dic_obj_search_info As Object
Set dic_obj_search_info = CreateObject("Scripting.Dictionary")
dic_obj_search_info.Add GB_ID, id
'更新値用の入れ物を用意
Dim dic_obj_update_info As Object
Set dic_obj_update_info = CreateObject("Scripting.Dictionary")
dic_obj_update_info.Add GB_ROW, row
dic_obj_update_info.Add GB_COL, col
dic_obj_update_info.Add GB_RATE, t_rate
dic_obj_update_info.Add GB_SUMMARY, summary
'更新処理を行う
Call update_info(GB_T_LAW_INFO_TABLE, dic_obj_search_info, dic_obj_update_info, law_info_table_map)
End If
'-------------問題ブック作成-------------
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'ブック作成
newBookName = no_chara & ".xlsx"
savepath = ThisWorkbook.path & "\" & licence_chara & "\" & category_chara & "\" & newBookName
' Debug.Print savepath
Call DeleteSomething
Set newBook = Workbooks.Add
ThisWorkbook.Activate
If mode = 1 Then
ThisWorkbook.Worksheets("問題作成").Copy after:=newBook.Sheets(newBook.Sheets.Count)
ElseIf mode = 2 Then
ThisWorkbook.Worksheets("編集").Copy after:=newBook.Sheets(newBook.Sheets.Count)
End If
newBook.Activate
'1枚目のシート以外は削除する
Dim i As Long
For i = 1 To Worksheets.Count - 1
newBook.Sheets(i).Delete
Next i
' newBook.Sheets("Sheet1").Delete
' newBook.Sheets("Sheet2").Delete
' newBook.Sheets("Sheet3").Delete
'シート名を変更
newBook.Sheets(1).Name = sheetname
'不要な行の削除
' Range("A2", Cells(Rows.Count, 1).End(xlUp)).EntireRow.Delete
'不要なフォームボタンの削除
Dim myShape As Variant
If Worksheets(sheetname).Shapes.Count > 0 Then
For Each myShape In Worksheets(sheetname).Shapes
'図形がフォームボタンなら削除
If myShape.Type = msoFormControl Then
myShape.Delete
End If
Next
End If
newBook.SaveAs savepath
newBook.Close False
Set newBook = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "登録完了です。"
regist_Form.no_TextBox = ""
regist_Form.row_TextBox = ""
regist_Form.col_TextBox = ""
law_Form.law_TextBox = ""
Cells(4, 4).Select
End Function
Sub open_law_Form()
law_Form.Show vbModeless
End Sub
Sub open_regist_form()
regist_Form.Show vbModeless
End Sub
Sub open_fill_chara_form()
fill_chara_Form.Show vbModeless
End Sub
Sub reset_question()
Dim rc As Integer
Dim myShape As Variant
rc = MsgBox("リセットしますか？", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
'A3行以下、文字、図形を削除
Call delete_all("A3", "問題作成")
' Range("A3", Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete
'
'
' If ThisWorkbook.Worksheets("問題作成").Shapes.Count > 0 Then
'
' For Each myShape In question_Book.Worksheets(1).Shapes
'
' myShape.Delete
'
' Next
'
' End If
Else
MsgBox "処理を中断します"
End If
End Sub
Function delete_all(delete_row_range As String, sheet_name As String)
'第一引数：ここで指定した行以下を削除 例 "A3"
'第二引数：削除を行いたいシート名を指定
Dim myShape As Variant
'文字情報を削除する
Range(delete_row_range, Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete
'画像情報を削除する
If ThisWorkbook.Worksheets(sheet_name).Shapes.Count > 0 Then
For Each myShape In Worksheets(sheet_name).Shapes
'フォームボタンは消さない
If myShape.Type <> msoFormControl Then
myShape.Delete
End If
'フォームボタンの削除について
'https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1155987826
' If myShape.FormControlType <> xlButtonControl Then
'
' myShape.Delete
'
' End If
Next
End If
End Function
Sub test()
'情報登録
Dim dic_obj_select_info As Object
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
Dim select_dto As Object
'存在チェック
dic_obj_select_info.Add GB_LICENCE, "電験三種"
dic_obj_select_info.Add GB_CATEGORY, "電技解釈"
dic_obj_select_info.Add GB_NUM, 1
Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map)
Debug.Print select_dto.Item(GB_ROW)
End Sub
Sub test_regist()
Dim dic_obj_insert_info As Object
Set dic_obj_insert_info = CreateObject("Scripting.Dictionary")
Dim tbList As ListObject
Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE)
dic_obj_insert_info.Add GB_LICENCE, "電験三種"
dic_obj_insert_info.Add GB_CATEGORY, "電技解釈"
dic_obj_insert_info.Add GB_NUM, "10"
dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1
Call insert_info(GB_T_LAW_INFO_TABLE, dic_obj_insert_info, law_info_table_map)
End Sub
Sub test_update()
Dim dic_obj_update_info As Object
Set dic_obj_update_info = CreateObject("Scripting.Dictionary")
Dim dic_obj_search_info As Object
Set dic_obj_search_info = CreateObject("Scripting.Dictionary")
'検索条件
dic_obj_search_info.Add GB_CATEGORY, "電技解釈"
' dic_obj_search_info.Add GB_ID, 3
'更新値
dic_obj_update_info.Add GB_NUM, 40
dic_obj_update_info.Add GB_ROW, 90
Call update_info(GB_T_LAW_INFO_TABLE, dic_obj_search_info, dic_obj_update_info, law_info_table_map)
End Sub
Sub decompose_string_direct(str)
'入力された文字列をセルに1文字ずつ入れていく
Dim i As Long
Dim row As Long
Dim col As Long
row = 0
col = 1
Application.ScreenUpdating = False
'前の文字
Dim current_char As String
With ActiveCell
' str = .Value
For i = 1 To Len(str)
current_char = Mid(str, i, 1)
If current_char = "/" Then
row = row + 1
col = 1
Else
.Offset(row, col).Value = current_char
col = col + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Function DeleteSomething()
'シートコピー前のおまじない
'何を消してるんだろう？
Dim C As Name
For Each C In Names
C.Delete
Next
End Function
Sub セルに入力された文字列を一文字ずつ横方向に分解する()
'使ってない
Dim str As String
Dim i As Long
Dim row As Long
Dim col As Long
row = 0
col = 1
Dim length_linefeed_chara
'改行文字数
length_linefeed_chara = 30
Dim linefeed_count As Long
'改行を行った回数
linefeed_count = 0
Dim punctuation_mark_flg As Boolean
'句読点フラグ
punctuation_mark_flg = False
Dim blank_chara_start As String
'穴埋め文字が始まるのを判別する文字
blank_chara_start = "["
Dim blank_chara_end As String
'穴埋め文字が終わるのを判別する文字
blank_chara_end = "]"
Dim fill_in_the_blank_chara As String
Dim fill_in_the_blank_chara_count As Long
Dim merge_start As String
Dim merge_end As String
Dim fill_in_the_blank_flg
'穴埋めフラグ 当フラグがONの場合は改行しない
fill_in_the_blank_flg = False
Dim pre_char As String
'前の文字
Dim current_char As String
'今の文字
Dim next_char As String
'次の文字
Dim active_address_char As String
With ActiveCell
str = .Value
For i = 1 To Len(str)
punctuation_mark_flg = False
current_char = Mid(str, i, 1)
If i > 1 Then
pre_char = Mid(str, i - 1, 1)
next_char = Mid(str, i + 1, 1)
If current_char = blank_chara_start Then
fill_in_the_blank_flg = True
'ディクショナリを宣言
Dim dictionary_object_coordinate As Object
Set dictionary_object_coordinate = CreateObject("Scripting.Dictionary")
fill_in_the_blank_chara_count = 1
End If
If fill_in_the_blank_flg = True And current_char = blank_chara_end Then
fill_in_the_blank_flg = False
End If
'穴埋めの文字列の間は改行しない
If fill_in_the_blank_flg = False Then
'イロハニ問答無用で改行
If current_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ,ル]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
'漢数字ニ桁で改行
If current_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) And pre_char Like "[一,ニ,三,四,五,六,七,八,九,十]" Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
'漢数字一桁で改行
If current_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
If (i > length_linefeed_chara And Not current_char Like "[あ-ん]") And pre_char Like "[あ-ん]" Then
.Offset(1, 0).Select
row = row + 1
col = 1
If current_char = "、" Or current_char = "。" Then
punctuation_mark_flg = True
End If
length_linefeed_chara = i + 30
End If
End If
End If
next_loop:
If punctuation_mark_flg = False Then
.Offset(row, col).Value = current_char
If fill_in_the_blank_flg = True Then
fill_in_the_blank_chara = fill_in_the_blank_chara + current_char
' Debug.Print .Offset(row, col).Address(RowAbsolute:=False, ColumnAbsolute:=False)
'ディクショナリに文字座標をブッ込んでいく
dictionary_object_coordinate.Add fill_in_the_blank_chara_count, .Offset(row, col).Address(RowAbsolute:=False, ColumnAbsolute:=False)
fill_in_the_blank_chara_count = fill_in_the_blank_chara_count + 1
End If
'current_charが"]"だったら、各種処理を行う
'穴埋めセルの結合
'穴埋め文字始めの座標の登録
'穴埋め文字の登録
'ジャンル（ID、電験三種、電気事業法、一条、予備、予備）座標、穴埋め文字列をセットで登録する
'一条までは共通、以下座標ごとに個別
If current_char = blank_chara_end Then
merge_start = dictionary_object_coordinate.Item(2)
merge_end = .Offset(row, col - 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("問題展開").Range(merge_start & ":" & merge_end).Merge
Range(dictionary_object_coordinate.Item(2)).Value = Mid(fill_in_the_blank_chara, 2)
merge_start = ""
merge_end = ""
End If
col = col + 1
End If
Next i
End With
Debug.Print Mid(fill_in_the_blank_chara, 2)
End Sub
Sub pattern_test()
'使用していない
Dim str As String
' str = "ニ"
'
' If str Like "[イ,ロ,ハ,ニ]" Then
'
' Debug.Print str
'
' End If
str = "小売供給 一般の需要に"
If InStr(str, "") Then
Debug.Print "全角スペースだぜ"
End If
End Sub
Sub merge_cells()
'使用していない
Dim a As String
Dim b As String
Dim str As String
Range("A1").Select
a = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Worksheets("Sheet1").Range(a & ":B1").Merge
End Sub
Function get_kanji(str As String)
'使用していない
Dim kanji_flg As Boolean
kanji_flg = False
Dim kanji As String
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "[一-龠〃々〆〇]"
For i = 1 To Len(str)
current_char = Mid(str, i, 1)
If reg.test(current_char) Then
kanji_flg = True
End If
If reg.test(current_char) = False Then
kanji_flg = False
End If
If kanji_flg = True Then
kanji = kanji + current_char
End If
If kanji_flg = False Then
If Len(kanji) > 1 Then
Debug.Print kanji
End If
kanji = ""
End If
Next i
End Function
Sub decompose_string(str)
'使用していません
' Dim str As String
Dim i As Long
Dim row As Long
Dim col As Long
row = 0
col = 1
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "[一-龠〃々〆〇]"
Dim length_linefeed_chara
'改行文字数
length_linefeed_chara = 30
Dim linefeed_count As Long
'改行を行った回数
linefeed_count = 0
Dim punctuation_mark_flg As Boolean
'句読点フラグ
punctuation_mark_flg = False
Dim blank_chara_start As String
'穴埋め文字が始まるのを判別する文字
blank_chara_start = "["
Dim blank_chara_end As String
'穴埋め文字が終わるのを判別する文字
blank_chara_end = "]"
Dim fill_in_the_blank_chara As String
Dim fill_in_the_blank_chara_count As Long
Dim merge_start As String
Dim merge_end As String
Dim fill_in_the_blank_flg
'穴埋めフラグ 当フラグがONの場合は改行しない
fill_in_the_blank_flg = False
Dim pre_char As String
'前の文字
Dim current_char As String
'今の文字
Dim next_char As String
'次の文字
Dim next_next_char As String
'次の次の文字
'次の次の次の文字
Dim next_next_next_char As String
Dim active_address_char As String
With ActiveCell
' str = .Value
For i = 1 To Len(str)
punctuation_mark_flg = False
current_char = Mid(str, i, 1)
If i > 1 Then
pre_char = Mid(str, i - 1, 1)
next_char = Mid(str, i + 1, 1)
next_next_char = Mid(str, i + 2, 1)
next_next_next_char = Mid(str, i + 3, 1)
'穴埋めの文字列の間は改行しない
If fill_in_the_blank_flg = False Then
'イロハニ問答無用で改行
If current_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) Then
.Offset(1, 0).Select
row = row + 1
col = 2
length_linefeed_chara = i + 30
GoTo next_loop
End If
'漢数字三桁で改行
If current_char Like "[一,二,三,四,五,六,七,八,九]" And next_char Like "[十]" And next_next_char Like "[一,二,三,四,五,六,七,八,九]" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
'漢数字ニ桁で改行
If current_char Like "[一,二,三,四,五,六,七,八,九,十]" And next_char Like "[一,二,三,四,五,六,七,八,九,十]" And (InStr(next_next_char, " ") = 1 Or InStr(next_next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
'漢数字一桁で改行
If current_char Like "[一,二,三,四,五,六,七,八,九,十]" And (InStr(next_char, " ") = 1 Or InStr(next_char, " ") = 1) And Not pre_char Like "[一,二,三,四,五,六,七,八,九,十]" Then
.Offset(1, 0).Select
row = row + 1
col = 1
length_linefeed_chara = i + 30
GoTo next_loop
End If
'(イロハニ)で改行
If current_char = "(" And next_char Like "[イ,ロ,ハ,ニ,ホ,ヘ,ト,チ,リ,ヌ]" And next_next_char = ")" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) Then
.Offset(1, 0).Select
row = row + 1
col = 2
length_linefeed_chara = i + 30
GoTo next_loop
End If
'(123456789)で改行
If current_char = "(" And next_char Like "[１,２,３,４,５,６,７,８,９]" And next_next_char = ")" And (InStr(next_next_next_char, " ") = 1 Or InStr(next_next_next_char, " ") = 1) Then
.Offset(1, 0).Select
row = row + 1
col = 2
length_linefeed_chara = i + 30
GoTo next_loop
End If
If i > length_linefeed_chara And (pre_char = "、" Or pre_char = "。") Then
.Offset(1, 0).Select
row = row + 1
col = 2
length_linefeed_chara = i + 30
End If
If i > length_linefeed_chara And current_char Like "[あ-ん]" Then
.Offset(1, 0).Select
row = row + 1
col = 2
length_linefeed_chara = i + 30
End If
End If
End If
next_loop:
.Offset(row, col).Value = current_char
If current_char <> "" Then
col = col + 1
End If
Next i
End With
End Sub
Sub get_keisen()
Dim bs As Borders
Set bs = Range("D16", "AN20").Borders
Debug.Print (bs.LineStyle)
Debug.Print (bs.Weight)
End Sub
●module2
Option Explicit
Sub select_question()
'ランダムで選ばれたブックを開く
Dim id As Long
Dim select_dto As Object
Dim tbList As ListObject
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'------------------------超手抜き 連番で攻略したいの
Dim setter_number As Object
Dim getter_number As Object
Dim sequence_flg As Boolean
Dim setter_number_update As Object
sequence_flg = False
Dim sequence_num As Long
Set setter_number = CreateObject("Scripting.Dictionary")
setter_number.Add GB_T_ID, 1
Set getter_number = select_info(GB_T_NUMBER_TABLE, setter_number, number_table_map)
Debug.Print getter_number.Item(1).Item(GB_NUMBER1)
'number_tableの値を0にしておけばランダム出題になる
If getter_number.Item(1).Item(GB_NUMBER1) > 0 Then
id = getter_number.Item(1).Item(GB_NUMBER1)
sequence_num = getter_number.Item(1).Item(GB_NUMBER1)
'連番でやる意欲を感じるぜ
sequence_flg = True
Set setter_number = Nothing
Set getter_number = Nothing
Else
'ランダム出題
'------------------------law_info_tableから問題呼び出し--------------------------
'-------------------------------------------
' Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE)
' Randomize '乱数系列初期化
' id = Int(tbList.ListRows.Count * Rnd + 1)
'-------------------------------------------
'idをサイクルで取得する
Dim obj_subjects As Object
'科目を決められたサイクルで選び出す
Set obj_subjects = selectSubjects()
id = returnRndIdWithCategory(obj_subjects)
End If
'問題情報を各ブックから取得し演習シートにコピペ
Set select_dto = get_question(id, "演習")
'------------------------temporaryテーブルに問題の情報登録--------------------------
Set tbList = Worksheets(GB_T_TEMPORARY_TABLE).ListObjects(GB_T_TEMPORARY_TABLE)
'既存情報削除(レコードがない状態で行うとエラー)
If tbList.ListRows.Count > 0 Then
tbList.DataBodyRange.Delete
End If
'現在展開している問題の把握のため 問題の穴埋め箇所の更新等に利用
Dim dic_obj_insert_info As Object
Set dic_obj_insert_info = CreateObject("Scripting.Dictionary")
dic_obj_insert_info.Add GB_T_ID, 1
dic_obj_insert_info.Add GB_ID, select_dto.Item(1).Item(GB_ID)
dic_obj_insert_info.Add GB_LICENCE, select_dto.Item(1).Item(GB_LICENCE)
dic_obj_insert_info.Add GB_CATEGORY, select_dto.Item(1).Item(GB_CATEGORY)
dic_obj_insert_info.Add GB_NUM, select_dto.Item(1).Item(GB_NUM)
dic_obj_insert_info.Add GB_ROW, select_dto.Item(1).Item(GB_ROW)
dic_obj_insert_info.Add GB_COL, select_dto.Item(1).Item(GB_COL)
dic_obj_insert_info.Add GB_RATE, select_dto.Item(1).Item(GB_RATE)
dic_obj_insert_info.Add GB_SUMMARY, select_dto.Item(1).Item(GB_SUMMARY)
dic_obj_insert_info.Add GB_TEXT, select_dto.Item(1).Item(GB_TEXT)
Call insert_info(GB_T_TEMPORARY_TABLE, dic_obj_insert_info, temporary_table_map)
'------------------------問題解析--------------------------
Sheets("演習").Activate
Call register_fill_in_the_blank_character(select_dto.Item(1).Item(GB_ROW), select_dto.Item(1).Item(GB_COL))
Range("T2").Value = select_dto.Item(1).Item(GB_CATEGORY)
Set setter_number = CreateDictionary
Set setter_number_update = CreateDictionary
'連番で解答したいの
If sequence_flg = True Then
'カウントアップ
sequence_num = sequence_num + 1
setter_number.Add (GB_T_ID), 1
setter_number_update.Add (GB_NUMBER1), sequence_num
Call update_info(GB_T_NUMBER_TABLE, setter_number, setter_number_update, number_table_map)
sequence_flg = False
End If
Dim times As Long
times = select_dto.Item(1).Item(GB_C_TIMES)
'サイクル用に解答回数+1
Dim setter_target As Object
Dim setter_value As Object
Set setter_target = CreateDictionary
Set setter_value = CreateDictionary
setter_target.Add GB_ID, id
setter_value.Add GB_C_TIMES, times + 1
Call update_info(GB_T_LAW_INFO_TABLE, setter_target, setter_value, law_info_table_map)
'サイクルカウントアップ
Call updateCycleNO
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function register_fill_in_the_blank_character(last_row As Long, last_col As Long)
'[]でくくられている文字とセル座標を取得し登録する
Dim tbList As ListObject
Set tbList = Worksheets(GB_T_FILL_WORD_TABLE).ListObjects(GB_T_FILL_WORD_TABLE)
'既存情報削除(レコードがない状態で行うとエラー)
If tbList.ListRows.Count > 0 Then
tbList.DataBodyRange.Delete
End If
Dim i As Long
Dim j As Long
Dim fill_flg As Boolean
Dim start_address As String
Dim str As String
fill_flg = False
For i = 1 To last_row
For j = 1 To last_col
If fill_flg = True Then
'Debug.Print Cells(i, j).Value
str = str & Cells(i, j).Value
End If
If Cells(i, j).Value = "[" Then
start_address = Cells(i, j + 1).Address(False, False)
fill_flg = True
End If
If Cells(i, j + 1).Value = "]" Then
Range(start_address & ":" & Cells(i, j).Address(False, False)).Merge
Range(start_address).Value = ""
Range(start_address).Interior.ColorIndex = 19
Dim dic_obj_insert_info As Object
Set dic_obj_insert_info = CreateObject("Scripting.Dictionary")
dic_obj_insert_info.Add GB_ID, tbList.ListRows.Count + 1
dic_obj_insert_info.Add GB_PLACE, start_address
dic_obj_insert_info.Add GB_WORD, str
Call insert_info(GB_T_FILL_WORD_TABLE, dic_obj_insert_info, fill_word_table_map)
start_address = ""
str = ""
fill_flg = False
End If
Next j
Next i
End Function
Sub edit_question()
'問題の編集を行う
'temporaryから問題情報取得
'問題作成シートに展開
Dim select_dto As Object
Dim question_info_dto As Object
Dim dic_obj_select_info As Object
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
'------------------------temporary_table--------------------------
'一時テーブルから現在展開されている問題情報を取得する
dic_obj_select_info.Add GB_T_ID, 1
Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map)
'初期化
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
'------------------------law_info_table-------------------------
'law_info_tableから情報を取得する
dic_obj_select_info.Add GB_ID, select_dto.Item(1).Item(GB_ID)
Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map)
'問題を呼び出す
Set question_info_dto = get_question(select_dto.Item(1).Item(GB_ID), "編集")
ThisWorkbook.Save
Set question_info_dto = Nothing
End Sub
Function get_question(id As Long, sheet_name As String) As Object
'問題を呼び出す関数
'第一引数 id
'第二引数 呼び出した問題を展開するシート名
'呼ばれるタイミング
Dim question_Book As Workbook
Dim licence_chara As String
Dim category_chara As String
Dim question_path As String
Dim num As Variant
Dim row As Long
Dim col As Long
Dim select_dto As Object
Dim dic_obj_select_info As Object
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets(sheet_name).Activate
'既存削除
' Worksheets(sheet_name).Range("A3", Cells(Rows.Count, 1).End(xlDown)).EntireRow.Delete
Call delete_all("A3", sheet_name)
dic_obj_select_info.Add GB_ID, id
Set select_dto = select_info(GB_T_LAW_INFO_TABLE, dic_obj_select_info, law_info_table_map)
licence_chara = select_dto.Item(1).Item(GB_LICENCE)
category_chara = select_dto.Item(1).Item(GB_CATEGORY)
num = select_dto.Item(1).Item(GB_NUM)
row = select_dto.Item(1).Item(GB_ROW)
col = select_dto.Item(1).Item(GB_COL)
question_path = ThisWorkbook.path & "\" & licence_chara & "\" & category_chara & "\" & num
Set question_Book = Workbooks.Open(question_path, 3)
'文字情報の貼り付け
question_Book.Worksheets(1).Range(Cells(3, 1), Cells(row, col)).Copy
ThisWorkbook.Activate
Worksheets(sheet_name).Cells(3, 1).PasteSpecial xlPasteAll
'画像情報の貼り付け
'穴埋め問題ジェネレーター.xlsmの演習シートが選択されている
Dim myShape As Variant
If question_Book.Worksheets(1).Shapes.Count > 0 Then
For Each myShape In question_Book.Worksheets(1).Shapes
myShape.Copy
ActiveSheet.Paste
'myShape.Top+30等で貼り付ける位置を調整できる
Selection.Top = myShape.Top
Selection.Left = myShape.Left
Next
End If
Worksheets(sheet_name).Activate
Worksheets(sheet_name).Cells(3, 1).Select
'ThisWorkbook.Save
question_Book.Close savechanges:=False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set get_question = select_dto
End Function
Sub open_edit_form()
Dim select_dto As Object
Dim dic_obj_select_info As Object
Set dic_obj_select_info = CreateObject("Scripting.Dictionary")
Dim t_rate As Long
dic_obj_select_info.Add GB_T_ID, 1
Set select_dto = select_info(GB_T_TEMPORARY_TABLE, dic_obj_select_info, temporary_table_map)
' Debug.Print select_dto.Item(1).Item(GB_LICENCE)
edit_Form.licence_TextBox = select_dto.Item(1).Item(GB_LICENCE)
edit_Form.category_TextBox = select_dto.Item(1).Item(GB_CATEGORY)
edit_Form.no_TextBox = select_dto.Item(1).Item(GB_NUM)
edit_Form.row_TextBox = select_dto.Item(1).Item(GB_ROW)
edit_Form.col_TextBox = select_dto.Item(1).Item(GB_COL)
edit_Form.rate_ComboBox.ListIndex = select_dto.Item(1).Item(GB_RATE)
edit_Form.summary_TextBox = select_dto.Item(1).Item(GB_SUMMARY)
edit_Form.text_TextBox = select_dto.Item(1).Item(GB_TEXT)
edit_Form.licence_TextBox.Enabled = False
edit_Form.category_TextBox.Enabled = False
edit_Form.no_TextBox.Enabled = False
edit_Form.Show vbModeless
End Sub
Sub open_text()
'---------------------temporary_tableからテキストページを取得
Dim text_page As Long
Dim setter As Object
Dim getter As Object
Set setter = CreateObject("Scripting.Dictionary")
Set getter = CreateObject("Scripting.Dictionary")
setter.Add GB_T_ID, 1
Set getter = select_info(GB_T_TEMPORARY_TABLE, setter, temporary_table_map)
text_page = getter.Item(1).Item(GB_TEXT)
Dim path As String
Dim xClip
Set xClip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'クリップボードに開きたいPDFのページ数をコピー
xClip.SetText text_page
xClip.PutInClipboard
'まさかの決め打ち
path = ThisWorkbook.path & "\電験三種\テキスト\電験三種のエロ本応用編.pdf"
'pdfファイルを開く
With CreateObject("Wscript.Shell")
.Run path, 5
End With
With Application
.Wait Now + TimeValue("00:00:01")
.SendKeys "^+N", True 'CTRL+SHIF+Nを押す
.Wait Now + TimeValue("00:00:01")
.SendKeys "^v", True 'CTRL+Vを押す
.SendKeys "~", True 'エンターを押す
End With
End Sub
Function selectSubjects() As Object
'決められたサイクルで科目名を返却する
'サイクル番号はnumber_tableのcycle_noを使う
Dim setter As Object
Dim getter_subjects As Object
Dim getter_cycle_no As Object
Dim i As Long
Dim dto_subjects
Set dto_subjects = CreateDictionary
Set setter = CreateDictionary
'サイクルリストの条件
setter.Add GB_ID, "*"
'サイクルリストを取得する
Set getter_subjects = select_info(GB_T_QUESTION_CYCLE_TABLE, setter, question_cycle_table_map)
Set setter = Nothing
Set setter = CreateDictionary
' Debug.Print "selectSubjects.getter_subjects" & getter_subjects.Count
setter.Add GB_T_ID, 1
'現在のサイクル番号を取得する
Set getter_cycle_no = select_info(GB_T_NUMBER_TABLE, setter, number_table_map)
' Debug.Print "selectSubjects.getter_cycle_no" & getter_cycle_no.Count
For i = 1 To getter_subjects.Count
If getter_subjects.Item(i).Item(GB_C_ID) = getter_cycle_no.Item(1).Item(GB_NUMBER2) Then
dto_subjects.Add GB_LICENCE, getter_subjects.Item(i).Item(GB_LICENCE)
dto_subjects.Add GB_C_SUB_CATEGORY, getter_subjects.Item(i).Item(GB_C_SUB_CATEGORY)
dto_subjects.Add GB_C_TIMES, getter_subjects.Item(i).Item(GB_C_TIMES)
' Debug.Print "資格" & getter_subjects.Item(i).Item(GB_LICENCE)
' Debug.Print "カテゴリ" & getter_subjects.Item(i).Item(GB_C_SUB_CATEGORY)
' Debug.Print "回数" & getter_subjects.Item(i).Item(GB_C_TIMES)
Exit For
End If
Next i
Set selectSubjects = dto_subjects
End Function
Function updateCycleNO()
'今のサイクルNOをカウントアップする
'サイクル番号はmemory_tableのslot1を使う
Dim cycleNo As Long
Dim setter As Object
Dim setter_target As Object
Dim setter_value As Object
Dim getter_subjects As Object
Dim getter_cycle_no As Object
Set setter = CreateDictionary
Set setter_target = CreateDictionary
Set setter_value = CreateDictionary
setter.Add GB_ID, "*"
'サイクルリストを取得する
Set getter_subjects = select_info(GB_T_QUESTION_CYCLE_TABLE, setter, question_cycle_table_map)
Debug.Print getter_subjects.Count
Set setter = Nothing
Set setter = CreateDictionary
setter.Add GB_T_ID, 1
'現在のサイクル番号を取得する
Set getter_cycle_no = select_info(GB_T_NUMBER_TABLE, setter, number_table_map)
If getter_cycle_no.Item(1).Item(GB_NUMBER2) < getter_subjects.Count Then
cycleNo = getter_cycle_no.Item(1).Item(GB_NUMBER2) + 1
setter_target.Add GB_T_ID, 1
setter_value.Add GB_NUMBER2, cycleNo
Else
cycleNo = 1
setter_target.Add GB_T_ID, 1
setter_value.Add GB_NUMBER2, cycleNo
End If
Call update_info(GB_T_NUMBER_TABLE, setter_target, setter_value, number_table_map)
End Function
Function returnRndIdWithCategory(subjects As Object) As Long
'選択科目の問題からランダムにIDを返却する
Dim setter As Object
Dim getter As Object
Set setter = CreateDictionary
'資格名を設定する
setter.Add GB_LICENCE, subjects.Item(GB_LICENCE)
' Debug.Print "◇名" & subjects.Item(GB_LICENCE)
'カテゴリーが設定されていたら､条件に追加する
If subjects.Item(GB_C_SUB_CATEGORY) <> "" Then
setter.Add GB_C_SUB_CATEGORY, subjects.Item(GB_C_SUB_CATEGORY)
End If
' Debug.Print "カテゴリ" & subjects.Item(GB_C_SUB_CATEGORY)
'回数が設定されていたら 未出題に限定したいとき
If subjects.Item(GB_C_TIMES) <> "" Then
setter.Add GB_C_TIMES, subjects.Item(GB_C_TIMES)
End If
' MsgBox subjects.Item(GB_C_TIMES)
Set getter = select_info(GB_T_LAW_INFO_TABLE, setter, law_info_table_map)
If getter.Count = 0 Then
MsgBox "サイクルモードで科目または、カテゴリー設定に誤りがあります"
End
End If
' Debug.Print "カウント" & getter.Count
'ランダム番号を取得する
Dim randomNumber As Long
Randomize
randomNumber = Int(getter.Count * Rnd) + 1
' Debug.Print randomNumber
returnRndIdWithCategory = getter.Item(randomNumber).Item(GB_C_ID)
End Function
Sub randtest()
Dim tbList As ListObject
Set tbList = Worksheets(GB_T_LAW_INFO_TABLE).ListObjects(GB_T_LAW_INFO_TABLE)
Randomize '乱数系列初期化
Debug.Print Int(tbList.ListRows.Count * Rnd + 1) '1～6で乱数生成
End Sub
Sub longtest()
Dim a As Long
Dim b As Long
If IsEmpty(a) Then
Debug.Print "なんもないよ"
Else
Debug.Print a
End If
End Sub
Sub cycle_test()
Dim setter As Object
Dim getter As Object
Set setter = CreateDictionary
setter.Add GB_LICENCE, "消防4類乙"
Set getter = select_info(GB_T_LAW_INFO_TABLE, setter, law_info_table_map)
Debug.Print getter.Count
Debug.Print getter.Count
End Sub
●各ボタン
★問題作成シート
問題作成：open_law_form
穴埋め：open_fill_chara_form
問題登録：open_regist_form
リセット：reset_question
★演習シート
問題ガチャ：select_question
編集：edit_question
テキスト：open_text
★編集シート
問題作成：open_law_form
穴埋め：open_fill_chara_form
再登録する：open_edit_form
問題ガチャ：select_question
テキスト：open_text
パチンコに思うこと
コロナ真っ盛りですが、叩かれてますねパチンカー
自粛正義チームサイドにとっては良いカモですな。
私はパチンコには興味はないですが、ネットの投書欄を見ていると
そこまで言わんでエエやろと思ってます。
さて、StayHomeを実行している皆さん、自宅待機が始まって、
数日間は日々の過酷な労役からの解放感がハンパなかったと思います。
そろそろやることなくなってきてませんか。
どうですかー実際のところ。
回答①「ｿﾝﾅｺﾄﾅｲﾖｰ、ｼｭﾐﾆﾎﾞｯﾄｳﾃﾞｷﾃｻｲｺｰ」
はい①さん、あなた、あなたは三国一の幸せ者です。
回答②「うーん、そろそろやることなくなってきた、クソみたいな満員電車がなつい」
はい②さん、リリー・フランキーさんも言ってました、
仕事はヒマを潰すためににあると。
回答③「ジャンジャンバリバリ」
あー、さては③さん、3密MAXの所にいるでしょ。
壇蜜さんに蔑んだ目で見て欲しいの？そーいう趣味なの？
おそらく、②の人が多数で、①の人はごく少数なのではないでしょうか。
そして、②の人が感じているヒマヒマ感が、パチンカーの人が普段感じている
感覚なのではないでしょうか。
やることがない・・・
刺激がない・・・
あー、マズイ、マズイよあいつが出てくる。
バーン（扉を蹴破って入ってくる）
脳「おやおや、刺激の供出が遅れているようですが、早くしてもらえませんかね」
体「待ってください、この非常時では娯楽が限られているんです、
私はマインクラフトでラピュタ作るような変態（誉めてますよ）じゃあないんです」
脳「ほーん、じゃあ精神のバランス傾けてみよーかな（ハナホジ）」
体「待ってください、分かりました、ゆ○こから東京都民失格の焼き印を
ケツに押されてもいいので、外に遊びに行きます。ほんと勘弁してください。」
私達人間は頭蓋骨の中に納まっている、ブヨブヨのあいつの奴隷です。
あいつは、常に私達に刺激を要求してきます。
あいつは、私達に静止を許しません、常に運動を求めてきます。
さて、幸せ者の①さん、あなたは脳の良きしもべです。
あなたのステータスの興味の欄には、社会の目的から外れない立派のものが
記入されています。
そして、良い教育に恵まれたのですね、それを見出す機会がちゃんと
あったのですね。そのまま、続けてください。
・・・③の人はぶっちゃけ、ステータスの興味の欄に
悪意としか言えないものが書いてあるのではと
ちょっ、ステフリ（ステータス振り分け）担当の人ちゃんと仕事してーー
または、今の社会の目的にはそぐわないけど、別の社会では
ヒャッハーなのかもしれません。
（ちなみに、今の社会で最強な人の興味の欄には「効率化」と書いてあると思う。）
③「なんだか現世に放りだされたけど、別に望んでねーし、
脳は刺激を求めてくるし、ハァー趣味だってねえし
（興味の欄に「川の石の裏を見るが好き」と書いてある）」
パチンコは③の人の救いになっているではないでしょうか
パチンコの収支はトントンだと聞いています。
勝つときもあれば負ける時もある。
負けているときはクソみたいな気分だけど、勝っているときは天にも昇る気分
そして、謎の石を現金に交換できる。
時間も潰せるし、かなりの差分の刺激が得られる（電圧みたいなイメージ）
最強の価値交換ツール「お金」が手に入ることもある。
③の人、今苦しくてたまらないでしょう。
つまんなくて、つまんなくて、つまんなくて。
それなのに脳から刺激の要求は通常運転で・・・
パチンコは③の人用の療養所みたいなとこなのではないのでしょうか。
普段仕事があるおかけで実は③だというのが露見していない人も
たくさんいるでしょう。
これ以上StayHomeが続くとヒマすぎて精神のバランスを崩す人が
ばんばん出てきて大変なことになりそう。
ドコモの５Gイベントに行ってきました。
５G？
ドコモの５Gイベントに行ってきました。
そして、５Gのすごさは全然実感できませんでした。
通信速度目に見えないしな。くっ。
MR ミックスリアリティ
展示で一番パンチがあったのはMRでした。
あちこちに magic leapの実機があり、体験もできました。
このグラスをつけると、現実の視覚に虚像を重ねることができます。
虚像はあたかも空間に固定されているように見えます。
太陽系の映像を見せてもらいました。
太陽系が目の前に広がっていて、歩いて色んな角度から見てみましたが、
没入感は中々のものでした。
しかし、MRが家庭に降りてくるまでには年単位必要なのではないかと感じました。
magic leapは数年前からかなり話題になっていて、かなり期待していたのですが、
ちょっとがっかりでした。
・映像がカクカク
昔のPCで最新の３Dゲームをプレイした感覚です。
・準備に時間がかかる
体験前に5分くらいの機器調整タイムがありました。
・虚像をうまく操作できない
中央のカメラで人の手の動きを認識して、映し出されている虚像を
操作できる（つまんだり、ボタンを押したり）のですが、
精度が悪いです。
なんだか不穏な記事もありますしね。
IOT
ブログ主はメンテナンス系の仕事をしているので、IOTに興味があります。
現在は、設備の数値取りを人力で行っていますがこれどーにかなんねーかな
と常々思っています。
会場ではLPWAの文字があちこちで踊っていました。
これから人材不足が加速していくでしょうから、いかに人間を歩かせないかが
重要になってくるでしょう。
アナログメーターに取り付けるモジュール。
電源は乾電池。日数回の計測を3年できるみたいですよ、奥さん。
LPWAは小量データ（バイト単位）を小電力で送るもので、５Ｇとはほぼ関係ないの
ですが、各展示にはかなり力が入っていました。
Face Sharing
これゾクッとしました。
他人の顔の動きを体験できるというものなのです。まだ口だけですが、頬の筋肉を
電気刺激して強制的に動かすというなんだかイケナイ気がするやつです。
この技術が順当に発達していくと、人間そのものを操れるようになるでしょう。
例えば 電気工事なんて一度もやったことのない人を現場にいかせて、
ヘッドセットをかぶせて以下略）なんてことが実現できるようになるかも・・・
そんな世界では人の人材という価値はどーなってしまうのでしょうかね。
危機感
今回のイベントは５Ｇというより、通信に関係する最新テクノロジーの見本市
みたいなものでした。会場では仕事で来ている感のビジネス人が貪欲に展示を
物色しているが印象的でした。
ブログ主の仕事は最新テクノロジーとは縁遠く、地球ーαケンタウリ間くらいの
距離があります。
しかし、ある日突然導入されたIOTパッケージで仕事を1日で失うという未来が
安易に想像できます。
これからもこーいうイベントには参加して、その日に備えていこうと思います。
アマデウス紅莉栖とおしゃべりしてきました。
国際ロボット展改め「国際ロボットアーム展」に行ってきました
国際ロボットアーム展に行ってきました
毎年年末になると東京ビックサイトで開催されている
国際ロボット展に行ってきました。
ロボット展と名乗っていますが、あるのはほぼロボアームです。
アンドロイドのねーちゃんは見かけませんでした（涙
四方八方ロボアームだらけで最初は正直がっかりしました。
おすすめ巡回順
今回は巡回順がよろしくなかった。
アームロボット展にデートで行く人のためにおすすめ巡回順を教えよう。
巡回順を間違ってロボットアームしかないフロアに最初に行っちゃうと
カノジョ、めぐみん、5秒で飽きてエクスプロージョンだぜ。
え～おほん。
会場は2か所に分かれてます。
ビックサイトと 青海・西・南ホールの2か所です。
今回は時間の関係でビックサイトしか回れませんでした。
なので、ビックサイトのおすすめ巡回順です。
ビックサイトでは西１F、西４F、南１F、南４Fの合計４フロアです。
おすすめの巡回方法は①南４F②南１F③西１F④西４Fです
①はファミリー向けで、VRカヤックとかアシストスーツの試着等
体験型の展示も多めです。
②はYAMAHAや東芝等の誰でも知っているメーカーもあり、展示が華やかです。
コンパニオンのおねーちゃんも増し増しです。
③ロボットアームパラダイスです。みんな大好きDENSOのはんこロボもここです。
④ロボットアームパラダイスその２です。
ご想像の通り①から④にしたがって華やかさが下がって行きます。
私は③④①②と巡回してしまいました。エクスプロージョン。
考えるロボットアーム
展示で一番わくわくしたのが、南１FのMUJINの展示ブースでした。
ロボットアームを工場で使うとなると、ロボットアームの教育が必要なのですが、
これが結構時間がかかる上に、突発的な障害には弱いそうです。
MUJIN社のロボットアームは、自動運転に使われている技術「モーションプランニング」を使って、始点と終点を指定してあげれば自分で考えて最適な動作を自発的に
行うそうです。
ロボットアームの他にも自動で動くワゴンなどもあり
MUJINのロボットを使った完全自動物流倉庫が既に出来上がっているとのことです。
モーションプランニングは下記リンク参照
なっなんと。知らない内にもうそんなものが・・・
ちなみに、MUJINのブースのプレゼンターがかなり巧い方です。
もしロボット展行けたら、必ず見学してください。
以降のロボットアームの見方が変わります。
アシストスーツ＋α
重い荷物を持つ等、力仕事時に役立つアシストスーツを展示している企業が
ちらほらありました。
物流や介護等で腰にかかる負担を軽減する目的です。
正直そーいうのは既存でいろんなところ見かけるのですが、これは初めてです。
これ、手の動きもフレキシブルにアシストします。
守りたいのは腰だけじゃないですもんね。
運送屋さんに是非、早く普及させてあげて欲しい。
ロボライダー
YAMAHAのブースです。ライダーロボです。
このロボがプロライダーの記録に挑戦する映像が流れていました。
最初はラジコンバイクだと思っていたのですが、ロボの物理操作でした。
バイクに専用インタフェースつけて、ソフトウェア制御しろよ！！
でもイイ！！ロマンがある。
みんな大好きハンコロボ
いろんなところで物議を醸しだしたハンコロボです。
残念ながらハンコ現場は押さえられませんでした。
今は、紙の資料を1ページずつめくって電子化している最中です。
いろんな記事で、ハンコを押す点が取り上げられて
「まずハンコ決済文化をなくせよ」と突っ込まれていました。
説明文は「オフィス向け定型書面押印・冊子型書類の書面電子化」
ハンコを押すのが主目的ではなく
自動化したい業務フローのなかで自動化が難しい部分をなんとか
機械でやっちゃうというものみたいですね。
はい、変態技術に決定！！
日本のステキなマゾ達よ！！
ハンコロボを見て
「合理的に考えてハンコ決済なくせば全部おっけーだろ」と言うのも分かります。
しかしこの国民のマゾっぷりをなめてはいけません。
一揆しちゃうより米の増産に励むような連中です（誉め言葉）。
お上の声には「はい承知しました」です。
しかし思うのです。日本の技術の核心はこの変態さにあるのではないでしょうか。
最短ルートでは決してたどり着けない無駄な技術蓄積がある。
そして、その無駄は今は無駄だが未来には黄金に変わる時がある。
ハンコを押すロボットアームの動作の研究だって、多くの知見を生んだ
ことでしょう。
お金に直結しない技術開発に寛容であることはとてもいいことだと思います。
5年後の未来
5年後、世の中はどうなっているだろうか
今自分がやっている仕事はあるだろうか？
今回の展示で自動化が容赦なく進んでいるのが実感できた。
ある日突然無防備で解雇にならないように
最新技術の動向は探っていこう、来年も行くで。
書籍紹介 統計学が最強の学問である［数学編］
どーも
高校の頃、微分あたりで数学から足を洗った者です。
当時は「コレなんの役にたつの？」ってスナック感覚で
ドロップアウトしちゃいました。
それから数十年・・・
数学の本ばかり増えてます。
しかも、ほとんど読んでねーの（笑
電験三種の受験で多少の数学は学び直したのですが
数学はできるようになっておいた方が良いというのは
分かっているんですけどね。
なんかこう、それ学んで実利はあるのかってすぐに思っちゃうんですよね。
そうなんです。数学を勉強する目的がはっきりないんです。
だから三日坊主です。
そんな私ですが、じっくり読んで、手を動かしてみようと
思える数学の本に出会いました。
統計学が最強の学問である［数学編］――データ分析と機械学習のための新しい教科書
https://www.amazon.co.jp/dp/B077SCQGQ3/ref=dp-kindle-redirect?_encoding=UTF8&btkr=1
この本には明確な目的があります。タイトル通り
データ分析と機械学習に使う数学を理解することです。
私は今そーいうのとは全く関係ない仕事してます。
しかし、データ分析と機械学習を知ってる、使えるは
これからある程度の収入を得るためには最低限の教養になるという予感があります。
3分の２ぐらい流し読みしたのですが、確率や微分積分、対数等の性質があれあれに
有用で、それから派生したそれそれに効いてくるというような説明がとてもイイ。
これで、数学の各分野に一本の背骨が通るんですよ。
今まで、数学の学習に挫折した理由は、各分野をまんべんなく均している間に
飽きちゃったことにあります。
データ分析と機械学習に必要な数学だけ
それだけを学ぶ。
わざわざ文章にしちゃったんで、続けるぞー。
そしてゴールはこれに挑戦すること。
https://www.oreilly.co.jp/books/9784873117584/
ＰＣとゲームについて
前回PCを購入したのが2014年初頭。
バトルフィールド4がやりたくて購入。20万ぐらいしたと思う。
それから約5年、PCゲームの要求スペックはどんどんあがり、
最新作のゲームをやるには現行のPCでは厳しくなってきた。
また、モニターがHDから4Kモニターになったため、ゲームをやるとなると
要求されるグラフィック性能もそれなりのものとなる。
さらに、PCがクソうるさい。冷却のためのファンがうるさ過ぎる。
最近引っ越しをして3階に住んでいるうえに、階下は大家一家という状況。
折角手にいれた「カドベヤ、ミナミ、サイジョーカイ」を手放したくない。
ぬうう、PC買い替えよう。
前と同じで、ドスパラでええか。おっ、静音PCはサイコムちゅうとこがええねんか、ほうほう、グラフィックカードは今は結構静かなのがあるのね。ふんふん。サイコムで買うたるわ。ほうほう、ファンにはこだわりがあって、ノクチュアとかいうメーカーがええねんて。そうや、ウチのPCファンがクソうるさくてかなわんのや、どーにーかしてやー。で、お値段15万えーん。
15万円かー。・・・他にも欲しいのあるのよね。pixcel4とかgopro MAXとかね。
んー。現行PCのファンとグラフィックカードだけ交換して、なんとかならんものやろか。
結果、なんとかなりました。
4Kでも非常に快適。
真ん中が最小値、右が最大値。GPU（グラフィックカード）は最大70℃まで上昇しているが、適正値。CPUの温度も問題なし、交換したファンが効いてる。
60℃までは1000rpmで回転するように設定してある（ファンの音を下げるには低回転にするのが良い、1000rpmを超えてくるとうるさくなってくる）。
ふふふ、いけたじゃないですかー。
しかも静か、購入したグラフィックカードはハイエンドの部類。
静音と性能は両立しないのがこれまでの世の掟
いい時代になったものです。
さて、次はグラフィックカードの購入特典であるゲームやりますよ。
「call of duty modern warfare 2019」
容量が150GB、150GBです。
グラフィックはかなり期待できるんじゃないでしょーか。
おらー プレイボタン ポチーーーーーーーーー
・・・このOSはゲームプレイに対応してません・・・
は？
教えてgoogleおじさん
googleおじさん「ほっほっほ、お主のwindowsは8.1じゃろ、このゲームは対応して
おらんのだよ」
まじかー
googleおじさん「ニッチなOS使うとるお前さんはAKBじゃなくて、あえて地下アイドルを応援して、通ぶってるタイプじゃろ」
うっ、うるせー、もう用が済んだんからネット空間に帰れよー。
OSのアップグレードが必要になってしまいました。
またお金がかかる予感です。
おとなしく、PC新規購入したほうが良かったのでは。
CPU周りのパーツもリフレッシュできるし。
まあ、お金かけずになんとかなったんだけどね。
そのへんについては次回へ続く。
はじまりのはじまり
ブログ始めました。
日々の鬱憤がＭＡＸなので、そろそろ
どこかで吐き出さにゃなぁと思っていました。
家族や、職場の立場の弱い人に憤りをぶつけるのではなく
書くことで昇華出来れば幸いかなぁと思います。
それでは、はじまり、はじまり。
