les impressions et les expressions

Excelアドイン自慢

une collection des add-ins sur Excel
originel, 31 octobre 2025

エクセルのアドインを自慢するだけの記事です。話の枕としてきっかけを短く述べたあと、目的別にアドインを自慢していきます。なお、VBAとかいう謎のミレニアムみたいな言語をがんばって書くのは面倒くさいという事情によりコードは大抵生成AIに書かせています。したがって自慢しているのはアイデアであるということにご留意ください。自慢するほどのアイデアか？

きっかけ

会社のパソコンでエクセルのアドインが使われていたので、アドインって便利かも、という気持ちになったことです。

サ集克服シリーズ

古いExcelを使っているので、Excel 2019やMicrosoft 365などで新たに登場した関数が使えません。これをユーザー定義関数によって補っていこうと思います。

IFS関数

Function IFS(ParamArray args() As Variant) As Variant
    Dim i As Long

    ' Ensure an even number of arguments (condition-value pairs)
    If UBound(args) Mod 2 <> 1 Then
        IFS = CVErr(xlErrValue)
        Exit Function
    End If
    ' Loop through condition-value pairs
    For i = 0 To UBound(args) Step 2
        If VBA.CBool(args(i)) Then
            IFS = args(i + 1)
            Exit Function
        End If
    Next i
    ' If no condition is TRUE, return #N/A
    IFS = CVErr(xlErrNA)
End Function

XLOOKUP関数

Function XLOOKUP(lookupValue As Variant, _
                     lookupArray As Variant, _
                     returnArray As Variant, _
                     Optional notFoundValue As Variant = CVErr(xlErrNA), _
                     Optional matchMode As Long = 0, _
                     Optional searchMode As Long = 1) As Variant

    Dim i As Long
    Dim matchIndex As Long
    Dim found As Boolean
    Dim lowerBound As Long, upperBound As Long

    lowerBound = LBound(lookupArray)
    upperBound = UBound(lookupArray)

    matchIndex = -1
    found = False

    ' Determine search direction
    If searchMode = -1 Then
        i = upperBound
        Do While i >= lowerBound
            If MatchFound(lookupValue, lookupArray(i), matchMode) Then
                matchIndex = i
                found = True
                Exit Do
            End If
            i = i - 1
        Loop
    Else
        For i = lowerBound To upperBound
            If MatchFound(lookupValue, lookupArray(i), matchMode) Then
                matchIndex = i
                found = True
                Exit For
            End If
        Next i
    End If

    If found Then
        XLOOKUP = returnArray(matchIndex)
    Else
        XLOOKUP = notFoundValue
    End If
End Function

その他

その他です。

「セルを結合すると、左上の端にあるセルの値のみが保持され、他のセルの値は破棄されます。」に立ち向かう

Sub MergeCellsWithData()
    Dim rng As Range
    Dim cell As Range
    Dim combinedText As String
    Dim firstCell As Range

    ' Exit if only one cell or nothing is selected
    If Selection.Count <= 1 Then Exit Sub
    Set rng=Selection Set firstCell=rng.Cells(1) ' The primary cell to hold data after merge
        
    ' Concatenate text from each cell using a line break (vbCrLf)
    For Each cell In rng
        If cell.Value <> "" Then
            If combinedText = "" Then
            combinedText = cell.Value
            Else
            ' Append next value with a line break
            combinedText = combinedText & vbCrLf & cell.Value
            End If
        End If
    Next cell

    ' Disable the standard Excel warning: "Merging cells only keeps the upper-left value..."
    Application.DisplayAlerts = False

    ' Execute the merge and formatting
    With rng
        .Merge
        .Value = combinedText
        .VerticalAlignment = xlCenter ' Center text vertically (optional)
        .WrapText = True ' Required to display the line breaks correctly
    End With

    ' Re-enable Excel alerts
    Application.DisplayAlerts = True
End Sub

こんな感じでクイックアクセスツールバーに登録しておくと使いやすいと思います。

組み込みかた

必要ないかもしれませんが、中学生のころコードだけ書いてあって動かし方が書いてないサイトがきらいだったので書いておきます：

アドインの作成

  1. Excelで新しいファイルを開き、Alt + F11でVBAエディタに入る
  2. ツールバー「挿入（I）」 > 「標準モジュール（M）」で標準モジュールを挿入
  3. 出てきた標準モジュールに上記コードを書きいれる
  4. Alt + QでVBAエディタを抜ける
  5. 「名前を付けて保存」でファイルの種類「Excel アドイン (.xlam)」を選び、適当な名前・場所に保存（このファイルはずっと消さずにおいておくことに配慮した場所に保存しよう）

アドインのインストール

  1. Excelで適当なファイルを開き、リボン「ファイル」 > 「オプション」 > 「アドイン」
  2. ポップアップ左下　管理「設定（G）」 > 「参照（B）」 > さきほど作成したxlam形式のファイルを選択して「開く（O）」
  3. OK等をたくさん押して設定から抜け完了

補遺

最近メイン機がLinuxになったのでExcelはサブ機でしか使わなくなりました。意味ないじゃん……。

終わりです。

RETOURNER