lunark

Option Explicit On
Option Strict On

Public Class clsSQLite

    Public Enum ErrArgs
        None = 0
        NotFoundDBFile = 1
        AlreadyExistsDBFile = 2
    End Enum

lunark

// Try edit msg
var b1024string = '院陰隠韻吋右宇烏羽迂雨卯鵜窺丑碓臼渦嘘唄欝蔚鰻姥厩浦瓜閏噂云運雲荏餌叡営嬰影映曳栄永泳洩瑛盈穎頴英衛詠鋭液疫益駅悦謁越閲榎厭円園堰奄宴延怨掩援沿演炎焔煙燕猿縁艶苑薗遠鉛鴛塩於汚甥凹央奥往応押旺横欧殴王翁襖鴬鴎黄岡沖荻億屋憶臆桶牡乙俺卸恩温穏音下化仮何伽価佳加可嘉夏嫁家寡科暇果架歌河火珂禍禾稼箇花苛茄荷華菓蝦課嘩貨迦過霞蚊俄峨我牙画臥芽蛾賀雅餓駕介会解回塊壊廻快怪悔恢懐戒拐改魁晦械海灰界皆絵芥蟹開階貝凱劾外咳害崖慨概涯碍蓋街該鎧骸浬馨蛙垣柿蛎鈎劃嚇各廓拡撹格核殻獲確穫覚角赫較郭閣隔革学岳楽額顎掛笠樫橿梶鰍潟割喝恰括活渇滑葛褐轄且鰹叶椛樺鞄株兜竃蒲釜鎌噛鴨栢茅萱粥刈苅瓦乾侃冠寒刊勘勧巻喚堪姦完官寛干幹患感慣憾換敢柑桓棺款歓汗漢澗潅環甘監看竿管簡緩缶翰肝艦莞観諌貫還鑑間閑関陥韓館舘丸含岸巌玩癌眼岩翫贋雁頑顔願企伎危喜器基奇嬉寄岐希幾忌揮机旗既期棋棄機帰毅気汽畿祈季稀紀徽規記貴起軌輝飢騎鬼亀偽儀妓宜戯技擬欺犠疑祇義蟻誼議掬菊鞠吉吃喫桔橘詰砧杵黍却客脚虐逆丘久仇休及吸宮弓急救朽求汲泣灸球究窮笈級糾給旧牛去居巨拒拠挙渠虚許距鋸漁禦魚亨享京供侠僑兇競共凶協匡卿叫喬境峡強彊怯恐恭挟教橋況狂狭矯胸脅興蕎郷鏡響饗驚仰凝尭暁業局曲極玉桐粁僅勤均巾錦斤欣欽琴禁禽筋緊芹菌衿襟謹近金吟銀九倶句区狗玖矩苦躯駆駈駒具愚虞喰空偶寓遇隅串櫛釧屑屈掘窟沓靴轡窪熊隈粂栗繰桑鍬勲君薫訓群軍郡卦袈祁係傾刑兄啓圭珪型契形径恵慶慧憩掲携敬景桂渓畦稽系経継繋罫茎荊蛍計詣警軽頚鶏芸迎鯨劇戟撃激隙桁傑欠決潔穴結血訣月件倹倦健兼券剣喧圏堅嫌建憲懸拳捲検権牽犬献研硯絹県肩見謙賢軒遣鍵険顕験鹸元原厳幻弦減源玄現絃舷言諺限乎個古呼固姑孤己庫弧戸故枯湖狐糊袴股胡菰虎誇跨鈷雇顧鼓五互伍午呉吾娯後御悟梧檎瑚碁語誤護醐乞鯉交佼侯候倖光公功効勾厚口向后喉坑垢好孔孝宏工巧巷幸広庚康弘恒慌抗拘控攻昂晃更杭校梗構江洪浩港溝甲皇硬稿糠紅紘絞綱耕考肯肱腔膏航荒行衡講貢購郊酵鉱砿鋼閤降項香高鴻剛劫号合壕拷濠豪轟麹克刻告国穀酷鵠黒獄漉腰甑忽惚骨狛込此頃今困坤墾婚恨懇昏昆根梱混痕紺艮魂些佐叉唆嵯左差査沙瑳砂詐鎖裟坐座挫債催再最哉塞妻宰彩才採栽歳済災采犀砕砦祭斎細菜裁載際剤在材罪財冴坂阪堺榊肴咲崎埼碕鷺作削咋搾昨朔柵窄策索錯桜鮭笹匙冊刷察拶撮擦札殺薩雑皐鯖捌錆鮫皿晒三傘参山惨撒散桟燦珊産算纂蚕讃賛酸餐斬暫残仕仔伺使刺司史嗣四士始姉姿

lunark

Option Explicit

'--- Win32 API 関数の宣言 ---
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
                                                                         ByVal dwMilliseconds As Long) As Long
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
                                                                 ByVal bInheritHandle As Long, _
                                                                 ByVal dwProcessId As Long) As Long
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

lunark

'******************************************************************
'■bottomRows関数
'Excel専用。特定の記入済みシートの末尾行を探す。
' 引数1：末尾判定対象シート：String
' 引数2：末尾判定対象列：String
' 返り値：末尾行番号：Double　※Excel2010対応のため
' Excel2003で使う場合は、1048576→65536へ変更のこと！
'******************************************************************

Function bottomRows(strSheetName As String, strColumnName As String) As Double

lunark

'******************************************************************
'■WriteUnicodePlainText関数
'UTF-8テキスト書き出し
'   引数1：書き出し先のフルパス
'   引数2：流し込みたい文字列が入った文字列変数
'Option Explicit必須、Microsoft JET2.8以上必須
'******************************************************************
Private Sub WriteUnicodePlainText(ByVal strFN As String, ByVal strTEXT As String)
    Dim adodbStream As ADODB.Stream
    Set adodbStream = New ADODB.Stream

lunark

Public Function GenderInterpolation(strN As String, strR As String, strGM As String, strGF As String, strN範囲 As String, strR範囲 As String, strG範囲 As String)

Dim intM As Long
Dim intF As Long
Dim intMax As Integer
Dim intMin As Integer
'----------------------------------------------
'名簿の中にある苗字と条件で、性別がどちらかを推定する
'----------------------------------------------
'

lunark

Public Function GenderEstimate(ByVal strMK As String, Optional strMF As String = "") As String
    GenderEstimate = ""
    strMK = Replace(Replace(Replace(strMK, "　", ""), " ", ""), "「", "")
    strMF = Replace(Replace(StrConv(strMF, vbHiragana), "　", ""), " ", "")

    'デバッグ用。こいつをブレークポイントに持ってきて挙動を確認する
    'If strMK Like "理世" Then
    '    Debug.Print strMK
    'End If

lunark

Public Function CutCityName(ByVal R As String) As String

Dim C As String '市
Dim T As String '町
Dim V As String '村
Dim K As String '区
Dim G As String '郡


If R Like "*　*" Then R = Left(R, InStr(1, R, "　"))