'--------------------------------------------------------------------------------------------------------------------

'--------------------------------------------------------------------------------------------------------------------
Option Explicit
Property Let Focus(ByVal Flag As Boolean)
    With Application
        .EnableEvents = Not Flag
        .ScreenUpdating = Not Flag
        .Calculation = IIf(Flag, xlCalculationManual, xlCalculationAutomatic)
    End With
End Property

Sub 席決めマクロ()
    If TypeName(Selection) <> "Range" Then
        MsgBox "セルを選択してから実行してください。", 16
        Exit Sub
    ElseIf Selection(1).Row = Selection(Selection.Count).Row _
            Or Selection(1).Column <> Selection(Selection.Count).Column _
            Or Selection.Areas.Count <> 1 Then
        MsgBox "縦にセルを選択してから実行してください。", 16
        Exit Sub
    End If

    Dim sur As Integer
    Dim suc As Integer
    Dim sdr As Integer
    Dim sdc As Integer
    Dim sMax As Integer
    Dim sMin As Integer
    Dim FoundCell As Range    ''またはバリアント型(Variant)とする
    Dim i As Integer
    Dim j As Integer
    Dim A() As Integer
    Dim myNum As Integer
    Dim myFlag() As Boolean
    sur = Selection(1).Row
    suc = Selection(1).Column
    sdr = Selection(Selection.Count).Row
    sdc = Selection(Selection.Count).Column
    sMax = sdr - sur + 1
    sMin = 18 - sdr + sur
    With ThisWorkbook.Worksheets("Sheet1")
        i = 0
        j = 0
        Do While i < sMax
            ReDim A(sdr - sur)
            Set FoundCell = .Cells(sur + i, suc).Find(What:="×")
            If FoundCell Is Nothing Then
                A(i) = 1
                j = j + 1
            Else
                A(i) = 0
            End If
            i = i + 1
        Loop
        i = 0
        sMin = 18 - j + 1
        Do While i < sMax
            ReDim myFlag(sMin To 18)
            Set FoundCell = .Cells(sur + i, suc).Find(What:="×")
            If FoundCell Is Nothing Then
                Do
                    '乱数=Int((最大値 - 最小値 +1 ) * Rnd + 最小値)
                    myNum = Int((18 - sMin + 1) * Rnd + sMin)
                Loop Until myFlag(myNum) = False
                myFlag(myNum) = True
                Cells(sur + i, 15).Value = myNum
            Else
                MsgBox sur + i & ":" & suc & "さんは" & "席必要なし。"
            End If
            'MsgBox "ランダムでA(" & i & ")=" & A(i) & "です。"
            i = i + 1
        Loop
    End With
    MsgBox "縦に" & sMax & "セルあります。" & vbCrLf, 16
End Sub

Sub Sample()
    Dim i As Long, myNum As Long
    Dim myFlag(1 To 10) As Boolean

    '乱数系列を初期化
    Randomize
    
    For i = 1 To 10
        Do
            '乱数=Int((最大値 - 最小値 +1 ) * Rnd + 最小値)
            myNum = Int((10 - 1 + 1) * Rnd + 1)
        Loop Until myFlag(myNum) = False
        
        Cells(i, 1).Value = myNum
        myFlag(myNum) = True
    Next i
End Sub



Sub 地図リンク一括作成_関数()
' =HYPERLINK("https://www.google.co.jp/maps/search/"&D2, "Google マップで表示") 「search」だと適当検索の可能性
' =HYPERLINK("https://www.google.co.jp/maps/place/"&D2, "Google マップで表示")  「place」
    Dim 行番号 As Integer
    Dim 検索リンク As String
    Dim リンク名 As String
    行番号 = 2
    検索リンク = "https://www.google.co.jp/maps/place/"
    リンク名 = "Google マップで表示"
    Do Until Cells(行番号, 4).Value = ""
        ' 「列D」が空欄になるまで実行
        Cells(行番号, 7).ClearContents
        ' リンククリア
        Cells(行番号, 7).Formula = _
            "=HYPERLINK(" & """" & 検索リンク & """" & "&D" & 行番号 & "," & """" & リンク名 & """" & ")"
        ' 「列D」の住所を基にし、「列G」に地図リンク作成
        行番号 = 行番号 + 1
    Loop
End Sub

Sub 地図リンク一括作成_ハイパーリンク()
    Focus = True
    Const url$ = "https://www.google.co.jp/maps/place/"
    Const str$ = "Google マップで表示"
    Dim i As Integer
    With ThisWorkbook.Worksheets("住所録")
        i = 2
        Do While .Cells(i, 4).Value <> ""
            .Cells(i, 7).ClearContents
            .Hyperlinks.Add _
                Anchor:=.Cells(i, 7), _
                Address:=url & .Cells(i, 4), _
                ScreenTip:=.Cells(i, 4).Value, _
                TextToDisplay:=str
            i = i + 1
        Loop
    End With
    Focus = False
End Sub