เอาผลจากคอลัมน์มาเขียนคำสั่ง VBA ให้สร้างอีก 1 คอลัมน์

[aroydee]

ไฟล์ กับ Code ล่าสุดครับ
Code ใน Module4
Sub Card0() กับ Sub AddScore()
ปัญหาคือ.....
1.คีย์เลขใหม่ (ลองเลข 0 แค่ตัวเดียว) มันแสดงใน Card น้ำเงินซ้ำแค่ช่องแรกช่องเดียว
ไม่ยอมไปช่อง 2...6 ครับ
2.ลองคีย์เลขด้วยคีย์บอร์ดจนครบ 6 ตัว แล้ว กดบันทึกแต้ม..มันไปแสดงที่แถว C25:H25 แล้ว
แต่ตอนจะลบเซลล์ Card 6 ตัวทิ้ง (Card น้ำเงิน-แดง ด้านบน) มันบอก "ทำเช่นนั้นกับเซลล์ผสานไมไ่ด้"

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
Sub AddScore()
Application.ScreenUpdating = False
    With Sheets("Trics")
        Range("Pla").Copy                                         ' "Pla" = $B$2:$F$2  เป็นเซลล์ผสาน
        Range("C" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("Bnk").Copy                                       ' "Bnk" = $B$2:$F$2  เป็นเซลล์ผสาน
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("Pla").ClearContents
        Range("Bnk").ClearContents
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
Dim r As Range, l As Integer, i As Integer
With Sheets("Trics")
    l = .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    i = 0
    For Each r In .Range("b2,d2,f2")
        .Range("c" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
    For Each r In .Range("i2,k2,m2")
        .Range("c" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
    .Range("b2,d2,f2,i2,k2,m2").Value = ""
End With
'Other code

[aroydee]

อันนี้คือ Code สำหรับการ AddScore หรือ บันทึกแต้ม .....ลองแล้วโอเคครับ
แต่ส่วนการคีย์เลขยังไม่ได้เลยครับ
...หลังจากคีย์เลข 0 ครั้งแรก มันแสดงที่ Card น้ำเงินช่องแรกครับ
พอคีย์ครั้งที่ 2 (ลองเลข 0 แค่ตัวเดียว) เพื่อให้แสดงใน Card น้ำเงินช่องที่ 2
แต่มันยังแสดงซ้ำใน Card น้ำเงินช่องแรกช่องเดียว
ไม่ยอมไปช่อง 2...6 ครับ

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

[snasui]

กรุณาแนบไฟล์ล่าสุดที่ได้ Update Code ที่ผมตอบไปแล้วมาด้วย

ช่วยลำดับขั้นตอนการทดสอบให้เห็นปัญหาโดยผู้ตอบได้ทำตามขั้นตอนที่แจ้งแล้วพบปัญหาเดียวกัน จะได้เข้าถึงปัญหาโดยไวครับ

[aroydee]

ไฟล์นี้ครับ
ส่วนการคีย์เลขยังไม่ได้เลยครับ
...หลังจากคีย์เลข 0 ครั้งแรก มันแสดงที่ Card น้ำเงินช่องแรกครับ
พอคีย์ครั้งที่ 2 (ลองเลข 0 แค่ตัวเดียว) เพื่อให้แสดงใน Card น้ำเงินช่องที่ 2
แต่มันยังแสดงซ้ำใน Card น้ำเงินช่องแรกช่องเดียว
ไม่ยอมไปช่อง 2...6 ครับ

[aroydee]

ใน Module4, Sub Card0()
จุดมุ่งหมาย คือ
คีย์เลข 0 ครั้งแรก ให้แสดงใน B2
คีย์เลข 0 ครั้งที่ 2 ให้แสดงใน D2
คีย์เลข 0 ครั้งที่ 3 ให้แสดงใน H2
คีย์เลข 0 ครั้งที่ 4 ให้แสดงใน I2
คีย์เลข 0 ครั้งที่ 5 ให้แสดงใน K2
คีย์เลข 0 ครั้งที่ 6 ให้แสดงใน M2

[snasui]

คีย์เลขศูนย์แต่ละครั้งที่ตำแหน่งไหนครับ

[aroydee]

ในปุ่มมาโคร แป้นตัวเลข 0-9 สีส้มครับ
แล้วถ้า คร้้งที่ 2, 3,..., 6 เป็นเลขในปุ่มอื่นๆ Code จะเหมือนกันไหมครับ
Code ที่เขียน คือ จะให้เลขไปแสดงที่เซลล์ [AA2] ก่อน แล้วค่อยคัดลอกไปช่อง Card ทั้ง 6 ใบ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Dim i As Integer
Sub Card0()
    Dim o As Object, a As Variant
    Application.ScreenUpdating = False
    With Sheets("Trics")
        Set o = .Shapes(Application.Caller)
        a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        .Range(a(i)).Value = o.TextFrame2.TextRange.Text
        i = i + 1
        If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub

โดยทุกตัวเลขจะต้องเรียกคำสั่งนี้ หรือนั่นคือ Assign ปุ่มตัวเลขทุกปุ่มให้เรียก Card0 หากคลิกครบ 6 เลขแล้วคลิกซ้ำก็จะวนมาเริ่มแสดงที่ B2 ใหม่ครับ

[aroydee]

ลองใส่แล้ว มันมีเส้นกั้นระหว่าง Dim i As Integer กับบรรทัด Sub Card0() ครับ
มันแยกห้องกัน
แล้วถ้าคีย์เลขผิด กด Back ลบถอยหลัง 1 ตัวได้ไหมครับ

[snasui]

การมีเส้นกั้นเป็นเรื่องปกติครับ

ตัวแปร i เป็นต้วแปรระดับ Module จึงเอาไว้ด้านบนสุด

คีย์ผิดก็ลบได้เป็นปกติ แต่ต้องเขียนลบมาเอง จะต้องศึกษาให้เข้าใจว่าสิ่งที่ผมเขียนไปให้คืออะไร ไม่เข้าใจก็ถามมาได้เรื่อย ๆ เพราะถ้าไม่เข้าใจก็ปรับปรุงเองไม่ได้ครับ

ถ้าจะทำงานกับ Code จำเป็นต้องศึกษาพื้นฐานอย่างเร่งด่วนครับ

[aroydee]

บันทึกเลขได้ละครับ

[aroydee]

อาจารย์ครับ
พอสั่ง Reset ใหม่ มันไม่กลับไปเริ่มที่ตัวแรกครับ
เดี๋ยวลองดูครับ

[snasui]

ในคำสั่ง Reset กำหนดค่าตัวแปร i ให้เป็น 0 เสียด้วยครับ

[aroydee]

ถ้าลบทีเดึยว 6 ตัวเลย ...ทำได้ครับ
แต่ลบย้อนกลับทีละตัว...ยังไม่ได้ครับ
Code อยู่ใน Module1

Code: Select all

Sub Back()
Application.ScreenUpdating = False
    Dim a As Variant
    With Sheets("Trics")

        'a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        a = Array("M2", "K2", "I2", "F2", "D2", "B2")
        .Range(a(i)).Value = ""
        i = i - 1
        If i = -1 Then i = 0
        If i = 6 Then i = 0      
        '.Range("B2,D2,F2,I2,K2,M2").Value = ""
    End With
Application.ScreenUpdating = True
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
With Sheets("Trics")
    i = i - 1
    If i = -1 Then i = 5
    a = Array("B2", "D2", "F2", "I2", "K2", "M2")
    .Range(a(i)).Value = ""
End With
'Other code

[aroydee]

ขอบคุณครับ

[aroydee]

ผมใช้คำสั่งซ่อนแถบเครื่องมือ..พอรันไปแล้วเครื่องมือหาย เลย Save ไฟล์ไม่่ได้
ต้องทำยังไงให้ไฟล์ถูก Save ก่อนปิดครับ

Code: Select all

Sub HideRibbon()
     ExecuteExcel4Macro ("SHOW.TOOLBAR(" & Chr(34) & "Ribbon" & Chr(34) & ",False)") ' Hide the ribbon
     Visible = True
End Sub

[snasui]

เขียนใน Event Workbook_BeforeClose เพื่อให้ Save ไฟล์ได้ครับ

ศึกษาเพิ่มเติมที่นี่ครับ https://docs.microsoft.com/en-us/office ... eforeclose

[aroydee]

อาจารย์ครับ Code นี้ คีย์ครบ 6 ตัวแล้ว (ยังไม่กดบันทึกแต้ม) ถ้าคีย์ต่อ มันจะไปเริ่มตัวที่ 1 ใหม่ วนไปเรื่อยๆ
ต้องการให้...เมื่อคีย์ครับ 6 ตัวแล้ว ถ้ายังไม่ได้กดบันทึก "ให้มันหยุด" แค่ตัวที่ 6 ยังไม่ต้องวนมาเริ่มใหม่
จนกดบันทึกแล้ว จึงค่อยมาเริ่มตัวที่ 1ใหม่

Code: Select all

Dim i As Integer
Sub Card0()
    Dim o As Object, a As Variant
    Application.ScreenUpdating = False
    With Sheets("Trics")
        Set o = .Shapes(Application.Caller)
        a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        .Range(a(i)).Value = o.TextFrame2.TextRange.Text
        i = i + 1
        If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub