入力事項を保存してユーザーフォームの利便性を上げる-抽選ソフト作成5

Sub 抽選項目バックアップ()

    Dim i, j As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        BUsheet.Select
        Cells.Clear
        
        For i = 101 To 109
           Cells(1, 1) = "抽選項目"
           Cells(1, 2) = "設定値"
           Cells(1, 3) = "当選本数"
           Cells(i - 100 + 1, 1) = 選定ナビ.Controls("Label" & i).Caption
        Next i
           
        Range("B2") = TItle
        Range("B3") = Par
        Range("B4") = EVD
        
        For j = 1 To 6
            Range("B" & 4 + j) = PrN(j)
            Range("C" & 4 + j) = PrQ(j)
        Next j
        
        Columns("A:C").AutoFit
End Sub

Sub 抽選項目バックアップ旧データ()

    Dim i As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        
        BUsheet.Select
        
        Call Module4.賞名空白対処
        
        For i = 1 To 10
            Range("A" & 12 + i) = "旧 " & Range("A" & i)
            Range("B" & 12 + i) = Range("B" & i)
            Range("C" & 12 + i) = Range("C" & i)
        Next i
        
        Range("B2") = 選定ナビ.抽選名称.Value
        Range("B3") = 選定ナビ.参加人数.Value
        Range("B4") = 選定ナビ.開催日付.Value
        
        Range("B5") = 選定ナビ.一位賞.Value
        Range("B6") = 選定ナビ.二位賞.Value
        Range("B7") = 選定ナビ.三位賞.Value
        Range("B8") = 選定ナビ.四位賞.Value
        Range("B9") = 選定ナビ.五位賞.Value
        Range("B10") = 選定ナビ.六位賞.Value
        
        Range("C5") = 選定ナビ.一位本.Value
        Range("C6") = 選定ナビ.二位本.Value
        Range("C7") = 選定ナビ.三位本.Value
        Range("C8") = 選定ナビ.四位本.Value
        Range("C9") = 選定ナビ.五位本.Value
        Range("C10") = 選定ナビ.六位本.Value
        
        Columns("A:C").AutoFit

End Sub

Sub 抽選項目更新()
    Dim i, j, k As Long
    Dim FArow As Long
    
        Set BUsheet = Worksheets("抽選項目BU")
        Set TYsheet = Worksheets("抽選会場")
        
        TYsheet.Select
        If Range("A1") = "" Then Exit Sub
        
        BUsheet.Select
        TItle = Range("B2")
        Par = Range("B3")
        EVD = Range("B4")
                
        Call Module4.賞名空白対処
                
        For i = 1 To 6
            PrN(i) = Range("B" & 4 + i)
            PrQ(i) = Range("C" & 4 + i)
            PrQn(i) = Val(StrConv(PrQ(i), vbNarrow))
            TYsheet.Range("C" & 4 + i) = PrQn(i) - TYsheet.Range("B" & 4 + i)
        Next i
                
        TYsheet.Select
        If Range("A1") = "" Then
            Range("C:C").ClearContents
        End If
        For j = 1 To 6
            TYsheet.Range("A" & 4 + j) = BUsheet.Range("B" & 4 + j)
        Next j
            
    '抽選会場当選結果、賞名のさかのぼり修正
        FArow = TYsheet.Cells(Rows.Count, 1).End(xlUp).Row
        BUsheet.Select
        For j = 1 To 6
            If Range("B" & 4 + j) <> Range("B" & 16 + j) Then
            
                For k = 12 To FArow
                    If TYsheet.Range("A" & k) = BUsheet.Range("B" & 16 + j) Then
                        TYsheet.Range("A" & k) = BUsheet.Range("B" & 4 + j)
                    End If
                Next k
            
            End If
        
        Next j
        TYsheet.Select

End Sub

Sub 賞名空白対処()

    Dim i As Long
    
        For i = 1 To 6
        
            If 選定ナビ.一位賞.Value = "" And 選定ナビ.一位本.Value <> "" Then
                        選定ナビ.一位賞.Value = "(仮)1位賞"
            ElseIf 選定ナビ.二位賞.Value = "" And 選定ナビ.二位本.Value <> "" Then
                        選定ナビ.二位賞.Value = "(仮)2位賞"
            ElseIf 選定ナビ.三位賞.Value = "" And 選定ナビ.三位本.Value <> "" Then
                        選定ナビ.三位賞.Value = "(仮)3位賞"
            ElseIf 選定ナビ.四位賞.Value = "" And 選定ナビ.四位本.Value <> "" Then
                        選定ナビ.四位賞.Value = "(仮)4位賞"
            ElseIf 選定ナビ.五位賞.Value = "" And 選定ナビ.五位本.Value <> "" Then
                        選定ナビ.五位賞.Value = "(仮)5位賞"
            ElseIf 選定ナビ.六位賞.Value = "" And 選定ナビ.六位本.Value <> "" Then
                        選定ナビ.六位賞.Value = "(仮)6位賞"
            End If
        
        Next i

End Sub

Sub 当選者リスト作成()

    Dim LCRow As Long
    
        Set TYsheet = Worksheets("抽選会場")
        Set TOsheet = Worksheets("当選者")
        
        If TYsheet.Range("A1") = "" Then Exit Sub
        
        TOsheet.Select
        Cells.Clear
        
        TYsheet.Select
        LCRow = TYsheet.Cells(Rows.Count, 3).End(xlUp).Row
        
        Range(Cells(3, 1), Cells(LCRow, 3)).Copy TOsheet.Range("A3")
        TOsheet.Select
        
        With TOsheet
            .Columns("A:C").AutoFit
            .Range("A1") = TItle '選定ナビ.抽選名称.Value
            .Range("C1") = EVD '選定ナビ.開催日付.Value
            .Range("A2") = Par & "人（口）" '選定ナビ.参加人数.Value & "人(口)"
        
            With .Range("A1,A2,C1").Font
                .Bold = True
                .Size = 13
            End With
        
        End With
        
        TYsheet.Select

End Sub