Snasui Excel Forum

Code: Select all

Sub Card0()
Application.ScreenUpdating = False
    With Sheets("Trics")
    If .Range("Pla" & Rows.Count).End(xlUp).Row = 10 Then Exit Sub
    [TargetPla] = 0
    [TargetBnk] = 0
    End With
Application.ScreenUpdating = True
End Sub
Sub Card1()
    Application.ScreenUpdating = False
    [TargetPla] = 1
    [TargetBnk] = 1
    Application.ScreenUpdating = True
End Sub
Sub Card2()
    Application.ScreenUpdating = False
    [TargetPla] = 2
    [TargetBnk] = 2
    Application.ScreenUpdating = True
End Sub
Sub Card3()
    Application.ScreenUpdating = False
    [TargetPla] = 3
    [TargetBnk] = 3
    Application.ScreenUpdating = True
End Sub
Sub Card4()
    Application.ScreenUpdating = False
    [TargetPla] = 4
    [TargetBnk] = 4
    Application.ScreenUpdating = True
End Sub
Sub Card5()
    Application.ScreenUpdating = False
    [TargetPla] = 5
    [TargetBnk] = 5
    Application.ScreenUpdating = True
End Sub
Sub Card6()
    Application.ScreenUpdating = False
    [TargetPla] = 6
    [TargetBnk] = 6
    Application.ScreenUpdating = True
End Sub
Sub Card7()
    Application.ScreenUpdating = False
    [TargetPla] = 7
    [TargetBnk] = 7
    Application.ScreenUpdating = True
End Sub
Sub Card8()
    Application.ScreenUpdating = False
    [TargetPla] = 8
    [TargetBnk] = 8
    Application.ScreenUpdating = True
End Sub
Sub Card9()
    Application.ScreenUpdating = False
    [TargetPla] = 9
    [TargetBnk] = 9
    Application.ScreenUpdating = True
End Sub
Sub NoCard()
    Application.ScreenUpdating = False
    [TargetPla] = "-"
    [TargetBnk] = "-"
    Application.ScreenUpdating = True
End Sub
Sub Back()
Application.ScreenUpdating = False
    [TargetUPla] = ""
    [TargetUBnk] = ""
Application.ScreenUpdating = True
End Sub
Sub Reset()
Application.ScreenUpdating = False
    Range("Pla").ClearContents
    Range("Bnk").ClearContents
Application.ScreenUpdating = True
End Sub
Sub NewGame()
Application.ScreenUpdating = False
    Range("Pla").ClearContents
    Range("Bnk").ClearContents
    Range("PCard").ClearContents
    Range("BCard").ClearContents
Application.ScreenUpdating = True
End Sub
Sub AddScore()
Application.ScreenUpdating = False
    With Sheets("Trics")
        Range("D3:D5").Copy
        Range("C" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True
        Range("G3:G5").Copy
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True
'Other code                            ... คัดลอก [K] ไป [AN]
'        Range("an" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
'            Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value
'Other code                            ... ไม่คัดลอกตัวเสมอ
If UCase(VBA.Left(Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value, 1)) <> "T" Then
    Range("an" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
            Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value
End If
'Other code
        Range("PS").ClearContents
        Range("BS").ClearContents
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Sub UndoScore()
Application.ScreenUpdating = False
    With Sheets("Trics")
    If .Range("C" & Rows.Count).End(xlUp).Row = 18 Then Exit Sub
    .Range("C" & Rows.Count).End(xlUp).Resize(1, 6).ClearContents
    End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Card0()
Application.ScreenUpdating = False
    With Sheets("Trics")
    'If .Range("Pla" & Rows.Count).End(xlUp).Row = 10 Then Exit Sub
    Dim i As Integer
    Dim sel As Range
    Set sel = [AQ2,AU2,AY2,BC2,BG2,BK2]
    For i = 1 To 6
        If i = 1 Then sel.Columns(i) = 0
        
        Next i

    End With
'Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Card0()
Application.ScreenUpdating = False
    With Sheets("Trics")
    Range("AA2") = 0
    Dim i As Integer
    Dim sel As Range
    Set sel = [B2,E2,H2,K2,N2,Q2]
        If UCase(VBA.Left(Range("AA2").Value, 1)) <> "" Then
        For i = 1 To 6
            If i = 1 Then sel.Columns(i).Value = [AA2]
            Next i
            End If
        Range("AA2").ClearContents
    End With
Application.ScreenUpdating = True
End Sub