KotorinChunChun

Attribute VB_Name = "kccFuncGraphics_partial"
Rem --------------------------------------------------------------------------------
Rem
Rem  @module        kccFuncGraphics_partial
Rem
Rem  @description   描画関係の関数群（モジュールからの抜粋）
Rem
Rem  @update        2024/04/28
Rem
Rem  @author        @KotorinChunChun (GitHub / Twitter)

KotorinChunChun

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

Option Explicit

Private fso As New FileSystemObject

Sub Test_GetLockUserName()
    Dim PathName As String
    PathName = "ここに試したいファイルのフルパスをかく"
   
    Debug.Print GetLockUserName(PathName)
End Sub

KotorinChunChun

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

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

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

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

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

Rem --------------------------------------------------------------------------------
Rem
Rem  @module        FormExcelColumnSwitcher
Rem
Rem  @description   エクセル表示列切り替えツール
Rem
Rem  @update        2021/09/19
Rem
Rem  @author        @KotorinChunChun (GitHub / Twitter)
Rem

KotorinChunChun

'二次元配列の列を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