Skip to content

Instantly share code, notes, and snippets.

View KotorinChunChun's full-sized avatar

KotorinChunChun KotorinChunChun

View GitHub Profile
@KotorinChunChun
KotorinChunChun / ThisWorkbook.cls.vba
Last active June 25, 2022 05:49
個人用マクロブックのPERSONAL.XLSBのThisWorkbookモジュールに書くだけで勝手にA1にカーソルが配置されるVBA
Rem 個人用マクロブックのPERSONAL.XLSBのThisWorkbookモジュールに書くだけで、
Rem 勝手にA1にカーソルが配置されるVBA
Option Explicit
Private WithEvents app As Excel.Application
Private Sub Workbook_Open()
Set app = Excel.Application
End Sub
@KotorinChunChun
KotorinChunChun / Module_GetLockingUserName.bas.vba
Created February 24, 2022 15:42
Excelブックが読み取り専用の時に現在開いているユーザーを特定する関数
Option Explicit
Private fso As New FileSystemObject
Sub Test_GetLockUserName()
Dim PathName As String
PathName = "ここに試したいファイルのフルパスをかく"
Debug.Print GetLockUserName(PathName)
End Sub
@KotorinChunChun
KotorinChunChun / LookupNearRGB.bas.vba
Last active December 27, 2021 23:05
RGBで最も近い色を特定する関数
Option Explicit
Rem 色特定サンプル
Sub Test_LookupNearRGB()
Dim r As Long
Rem A列に暫定基準カラーの生成
Dim baseRGBs As New Collection
For r = 1 To 8
Cells(r, 1).Interior.ColorIndex = r
@KotorinChunChun
KotorinChunChun / Sample_csv_reader.bas.vba
Created December 25, 2021 09:26
即興で書いたCSV読み込み関数
Rem CSV形式などのテキストファイルを二次元配列へ取り込む
Rem
Rem @param ssFilePath フルパス
Rem @param ssFieldDelimiter 列区切り(既定:カンマ)
Rem @param ssRecordDelimiter 行区切り(既定:CRLF)
Rem
Rem @return As Variant(1 to #, 1 to #) 二次元配列
Rem
Function ReadCsvTextFile( _
ssFilePath As String, _
@KotorinChunChun
KotorinChunChun / Test_Lookup.bas.vba
Last active December 25, 2021 03:01
VLOOKUP手法別の速度比較検証
Option Explicit
Property Get loDB(): Set loDB = Worksheets("DB").ListObjects(1): End Property
Property Get loVi(): Set loVi = Worksheets("View").ListObjects(1): End Property
Rem 総合テスト
Sub Test_LOOKUPs()
Application.ScreenUpdating = False
Dim tStart As Single, tStop As Single
@KotorinChunChun
KotorinChunChun / mod_VBA100_MagicBall002.bas
Last active September 20, 2021 13:44
VBA100本ノック 魔球編2 閉領域の塗り潰し
Rem VBA100本ノック 魔球編2 閉領域の塗り潰し
Option Explicit
Private Const NN未探索 = 0 '初期値。最終的に色を塗る対象となる
Private Const NN探索対象 = 1 '四方探索が予約された状態(最終的に0件となる)
Private Const NN探索済 = 2 '四方探索を終えた状態(領域外から繋がっている島ではない箇所)
Sub Main()
Dim rng As Range
Set rng = Worksheets("問").UsedRange
@KotorinChunChun
KotorinChunChun / mod_VBA100_MagicBall001.bas
Created September 19, 2021 13:56
VBA100本ノック 魔球編1 組み合わせ問題
Option Explicit
Rem 魔球編1 組み合わせ問題
Sub MagicBall001()
Dim srcArr: srcArr = CreateRandArray(5, 20, 40)
Dim retArr
retArr = func(srcArr, 100)
If IsEmpty(retArr) Then MsgBox Join(srcArr, ",") & "で100を超える組み合わせはありません": Exit Sub
Debug.Print Join(srcArr, ",") & " - " & Join(retArr, " + ") & " = " & Sum(retArr)
End Sub
@KotorinChunChun
KotorinChunChun / FormExcelColumnSwitcher.frm.vba
Last active September 19, 2021 14:02
エクセル表示列切り替えツール
Rem --------------------------------------------------------------------------------
Rem
Rem @module FormExcelColumnSwitcher
Rem
Rem @description エクセル表示列切り替えツール
Rem
Rem @update 2021/09/19
Rem
Rem @author @KotorinChunChun (GitHub / Twitter)
Rem
@KotorinChunChun
KotorinChunChun / vba_dictionary_miss.bas.vba
Last active March 4, 2021 16:52
VBAのDictionaryの要素の配列には値を代入できない教訓
'二次元配列の列をDictionaryへ、行をArray要素へ変換
Function ToDictionaryArrayByArray2D_NG(data) As Dictionary
Dim dic As New Dictionary
Dim i As Long, j As Long
For j = 1 To UBound(data, 2)
Dim arr
ReDim arr(1 To UBound(data, 1) - 1)
dic(data(1, j)) = arr
Next
@KotorinChunChun
KotorinChunChun / kncok.vba
Last active December 7, 2020 16:13
VBA100本ノック41本目
Option Explicit
Sub knock41()
Dim res As Dictionary: Set res = Quiz四則演算いっぱい出題(99, 20, 3)
Dim msg As Dictionary: Set msg = New Dictionary
Dim key, 正解数
For Each key In res.Keys
正解数 = 正解数 + IIf(res.Item(key), 1, 0)
msg.Add Join(Array( _
IIf(res.Item(key), "○", "×"), _