変奏現実

=LAMBDA(a,b,SQRT(a*b))

#CALC!

=LAMBDA(a,b,SQRT(a*b))(10,10) ⇒ 10

セル名：あああ
参照範囲：=LAMBDA(a,b,SQRT(a*b))

どこかのセルの式：あああ（10,10）⇒10

１回目：LAMBDA(0,1,0+1^2)
２回目：LAMBDA(1,2,1+2^2)
３回目：LAMBDA(5,3,5+3^2)
４回目：LAMBDA(14,4,14+4^2)
５回目：LAMBDA(30,5,30+5^2)
６回目：LAMBDA(55,6,55+6^2)
最後：91

=LET(対象セル,A1,
  Z,  LAMBDA(f, LET(g, LAMBDA(x, f(LAMBDA(v, LET(w, x(x), w(v) )))), g(g))),
  myfact, Z(LAMBDA(myfact, LAMBDA(x, IF(x=0, 1, x * myfact(x-1))))),
  myfact(対象セル)
)

=LET(対象セル,$A$1,
  myfact,  LAMBDA(x, IF(x=0, 1, x * myfact(x-1))),
  myfact(対象セル)
)
⇒ #NAME?

=LET(対象セル,$A$1,
  Z, ・・・（検討中）・・・
  myfact, Z(LAMBDA(myfact, LAMBDA(x, IF(x=0, 1, x * myfact(x-1))))),
  IF( 対象セル=0, 0, myfact(対象セル))
)　⇒　#CALC!

Z = lambda f: (lambda x: f(lambda *y: x(x)(*y)))(lambda x: f(lambda *y: x(x)(*y)))

LAMBDA(f, LET(g, LAMBDA(x, f(x(x)), g(g))))

LAMBDA(v, LET(w, x(x), w(v) ))

LAMBDA(f, LET(g, LAMBDA(x, f(LAMBDA(v, LET(w, x(x), w(v) )))), g(g)))

Option Explicit

Public Sub アクティブなブックのセル値を値に変換して保存()
On Error GoTo err1
    Call 非表示のワークシートを削除する(ActiveWorkbook)
    Call ワークシートのセル値を値に変換して保存(ActiveWorkbook)
    Call 普通のEXCELファイルに保存(ActiveWorkbook)
exit1:
    Exit Sub
err1:
    MsgBox Err.Description
    GoTo exit1
End Sub

Private Sub 非表示のワークシートを削除する(ByRef ワークブック As Excel.Workbook)
    Dim ワークシート As Excel.Worksheet
    For Each ワークシート In ワークブック.Worksheets
      If ワークシート.Visible <> Excel.XlSheetVisibility.xlSheetVisible Then
        '確認メッセージを非表示にする設定
        Excel.Application.DisplayAlerts = False
        '非表示のワークシートを削除
        ワークシート.Delete
        '確認メッセージを表示する設定
        Excel.Application.DisplayAlerts = True
      End If
    Next
End Sub

Private Sub ワークシートのセル値を値に変換して保存(ByRef ワークブック As Excel.Workbook)
    '全シート選択
    '条件：事前に非表示なワークシートは削除済みであること
    '非表示なワークシートが残っている場合は ワークブック.Sheets(Array("Sheet1", "Sheet2")).Selectな感じで表示ワークシートに限定して選択すること ）
    ワークブック.Sheets.Select
    '全ワークシートを選択
    ワークブック.Application.Cells.Select
    '全ワークシートをコピー
    ワークブック.Application.Selection.Copy
    '全ワークシートへ値としてペースト
    ワークブック.Application.Selection.PasteSpecial Paste:=xlPasteValues, _
      Operation:=xlNone, _
      SkipBlanks:=False, _
      Transpose:=False
    'コピペモードの解除
    ワークブック.Application.CutCopyMode = False
    'シート全体を選択したままになっているので、
    'A1のみ選択の状態にする
    Call ワークブック.Application.Cells(1, 1).Select
End Sub

Private Sub 普通のEXCELファイルに保存(ByRef ワークブック As Excel.Workbook)
    Dim ファイル名 As String
    '拡張子を削除　※削除しないと拡張子が重複する
    ファイル名 = Replace(ワークブック.FullName, ".xlsm", "")
    '確認メッセージを非表示
    ワークブック.Application.DisplayAlerts = False
    '普通のExcelファイルに保存
    ワークブック.SaveAs Filename:=ファイル名, _
      FileFormat:=xlOpenXMLWorkbook, _
      Password:="", _
      WriteResPassword:="", _
      ReadOnlyRecommended:=False, _
      CreateBackup:=False
    '確認メッセージを表示
    Application.DisplayAlerts = True
    '処理完了メッセージ
    MsgBox ファイル名 & ".xlsx" & vbCrLf & "に名前を変えて保存しました"    
End Sub

Public Sub 赤文字頁番号検索()
On Error GoTo err1

    '初期化
    Dim wordApp As Word.Application
    Set wordApp = CreateObject("Word.Application")
    '
    Dim 赤字の開始行 As Long
    赤字の開始行 = ActiveSheet.Range("タイトル行").row + 1

    Dim 赤字の列 As Long
    赤字の列 = ActiveSheet.Range("タイトル行").Find("赤字").Column
    
    Dim 頁番号の列 As Long
    頁番号の列 = ActiveSheet.Range("タイトル行").Find("頁番号").Column

    '検索対象のWORD文書を開く
    Dim wordFname As String
    wordFname = 検索対象のWORD文書名を調べる
    Dim wordDoc As Word.document
    Set wordDoc = 検索対象のWORD文書を開く(wordApp, wordFname)
    If TypeName(wordDoc) <> "Nothing" Then
        '赤文字を１文字選択する
        Call 赤文字を1文字選択する(wordDoc)
        '選択中の文字と同じ属性の文字を全て選択状態にする
        Call 選択中の文字と同じ属性の文字列を全部クリップボードにコピる(wordDoc)
        'ワークシートに貼り付ける
        ActiveSheet.Cells(赤字の開始行, 赤字の列).Select
        ActiveSheet.Paste
        'ワークシートの選択状態のセルの文字を検索する
        Dim row As Long
        For row = 赤字の開始行 To 赤字の開始行 - 1 + Selection.Count
            Dim text As String
            text = ActiveSheet.Cells(row, 赤字の列).Value
            Dim 頁番号 As Integer
            頁番号 = 赤字テキスト検索(wordDoc, text)
            If 頁番号 > 0 Then
                '右セルに頁番号を書き込む
                ActiveSheet.Cells(row, 頁番号の列).Value = 頁番号 & "頁"
            Else
                ActiveSheet.Cells(row, 頁番号の列).Value = "見つかりません"
            End If
            'ワークシートの選択状態の最後のセルまで繰り返す
        Next row
    End If
exit1:
    Call MSWORDをそのまま閉じる(wordApp)
    Exit Sub

err1:
    MsgBox Err.Description
    GoTo exit1

End Sub

Private Function 検索対象のWORD文書名を調べる() As String
    
    Dim ファイル名列 As Integer
    ファイル名列 = ActiveSheet.Range("タイトル行").Find("対象WORD文書名").Column
    Dim wordFname As String
    wordFname = ActiveSheet.Cells(ActiveSheet.Range("タイトル行").row + 1, ファイル名列)
    'ドライブレターやパスが無い場合
    If InStr(wordFname, "\") = 0 Then
        wordFname = ActiveWorkbook.Path & "\" & wordFname
    End If
    検索対象のWORD文書名を調べる = wordFname

End Function

Private Function 検索対象のWORD文書を開く(wordApp As Word.Application, docPath As String) As Word.document
On Error GoTo err1

    '読み取り専用
    Set 検索対象のWORD文書を開く = wordApp.Documents.Open(Filename:=docPath, ReadOnly:=True)
    Exit Function

err1:
    MsgBox Err.Description
    Set 検索対象のWORD文書を開く = Nothing

End Function

Private Sub 赤文字を1文字選択する(wordDoc As Word.document)

    '赤文字を検索
    wordDoc.ActiveWindow.Selection.Find.ClearFormatting
    wordDoc.ActiveWindow.Selection.Find.Font.Color = wdColorRed
    
    With wordDoc.ActiveWindow.Selection.Find
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = True
    End With
    
    wordDoc.ActiveWindow.Application.Selection.Find.Execute
    
    '１文字だけ選択する
    wordDoc.ActiveWindow.Selection.End = wordDoc.ActiveWindow.Selection.Start + 1

End Sub

Private Sub 選択中の文字と同じ属性の文字列を全部クリップボードにコピる(wordDoc As Word.document)

    '類似した書式の文字列を選択するWordマクロ三種     https://www.ka-net.org/blog/?p=5486
    wordDoc.Application.Run "SelectSimilarFormatting"
    'Application.CommandBars.FindControl(ID:=5946).Execute
    'Application.CommandBars.ExecuteMso "SelectTextWithSimilarFormatting"
    
    'クリップボードにコピる
    wordDoc.ActiveWindow.Selection.Copy

End Sub

Private Function 赤字テキスト検索(wordDoc As Word.document, text As String) As Integer

    赤字テキスト検索 = 0
    With wordDoc.Content.Find
        '赤文字を指定
        .ClearFormatting
        .Font.Color = wdColorRed
        'テキストを指定
        .text = text
        '順方向を指定
        .Forward = True
        'いざ検索
        .Execute
        '結果は？
        If .Found = True Then
            wordDoc.ActiveWindow.Selection.Start = .Parent.Start
            wordDoc.ActiveWindow.Selection.End = .Parent.End
            '頁番号を返す
            赤字テキスト検索 = wordDoc.ActiveWindow.Selection.Information(wdActiveEndAdjustedPageNumber)
            Exit Function
        End If
    End With

End Function

Private Sub MSWORDをそのまま閉じる(ByRef wordApp As Word.Application)

    Dim idx As Integer
    For idx = 1 To wordApp.Documents.Count
        wordApp.Documents(idx).Close SaveChanges:=wdDoNotSaveChanges
    Next
    wordApp.Quit
    Set wordApp = Nothing

End Sub