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

[aroydee]

ไฟล์นี้ครับ

[snasui]

ได้ปรับเพิ่มตรงไหนเพื่อให้ทำงานเช่นนั้นมาแล้วหรือไม่ ถ้ายัง กรุณาปรับมาเองก่อน ติดแล้วค่อยถามกันครับ

[aroydee]

เขียนมาแบบนี้ครับ

Code: Select all

Sub CardScore()                       
    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
        For Each a In Selection
        If .Range(a("M2")).Value = o.TextFrame2.TextRange.Text Then Exit Sub
        Else
            If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub

[snasui]

กรุณาแนบไฟล์ที่ได้ปรับ Code มาสุดมาแล้วเสมอ จะได้ตอบต่อไปจากนั้นครับ

[aroydee]

ตัวนี้ครับ

[snasui]

ตรง Peocedure CardScore ปรับเป็นด้านล่างครับ

Code: Select all

Sub CardScore()                        ' áÍÊ䫹ìÁÒâ¤Ã·Ø¡àÅ¢ÁÒ·Õè Sub ¹Õé Sub à´ÕÂÇ
    Dim o As Object, a As Variant
    If i = 6 Then Exit Sub
    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

ครง AddScore ปรับเป็น

Code: Select all

Sub AddScore()
Application.ScreenUpdating = False
'Other code
    Dim r As Range, l As Integer, k As Integer
    With Sheets("Trics")
        l = .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0).Row
        k = 0
        For Each r In .Range("B2,D2,F2")
            .Range("C" & l).Offset(0, i).Value = r.Value
            k = k + 1
        Next r
        For Each r In .Range("I2,K2,M2")
            .Range("C" & l).Offset(0, i).Value = r.Value
            k = k + k
        Next r
        .Range("B2,D2,F2,I2,K2,M2").Value = ""
    End With
'Other code
        [TargetBR] = [SourceBR]
        i = 0
    Application.ScreenUpdating = True
End Sub

ตัวแปร i เป็นตัวแปรระดับ Public ไม่ควรประกาศและใช้ซ้ำใน Procedure จะทำให้ตัวแปรแบบ Public ไม่ถูก Assign ค่าให้เป็นไปตามต้องการได้ครับ

[aroydee]

พอดีทางครูหัวหน้าแผนก เค้าให้แม่บ้านทำแผนการสอน เลยให้เขียนเป็นชีท excel ไปประกอบ
แล้วเรื่อง Code VBA เค้าไม่เป็นเลย ส่วนผมเป็นนักดนตรี ก็ไม่เคยเล่น excel เลยเหมือนกัน
พึ่งมาศึกษานี่แหล่ะครับ...ช่วยแม่บ้านทำ

[aroydee]

อาจารย์ครับ ...จะทำให้เซลล์ที่แสดงผลคือ .Sheets("Trics").Range("N25")
พอมีตัวแสดงผลโชว์..ให้เซลล์กระพริบ
ถ้าไม่มีตัวแสดงผล..ให้หยุดกระพริบ
อันนี้อยู่ใน Module2 ครับ แต่ไม่รู้จะไปยังไง

Code: Select all

Dim NextTime As Date
Sub StartFlash()
    NextTime = Now + TimeValue("00:00:01")
    With ActiveWorkbook.Styles("Flashing").Font
        If .ColorIndex = xlAutomatic Then .ColorIndex = 3
        .ColorIndex = 5 - .ColorIndex
    End With
    Application.OnTime NextTime, "StartFlash"
End Sub

Sub StopFlash()
    Application.OnTime NextTime, "StartFlash", schedule:=False
    ActiveWorkbook.Styles("Flashing").Font.ColorIndex = xlAutomatic
End Sub

[aroydee]

ไฟล์นี้ครับ

[snasui]

ลองปรับใช้จาก Link นี้ครับ ==> Blinking Text

[aroydee]

Code อยู่ใน Module1, Sub I_To_P2()
คอลัมน์ I คือ Code แสดงผลการบวกของตัวเลขในคอลัมน์ E ลงมาทีละแถว
คีย์ {W} ผลชนะ ได้เป็นเลขบวก
คีย์ {L} ผลแพ้ ได้เป็นเลขลบ
ปัญหาคือ ถ้ากดปุ่มมาโครในหน้าชีท "7 Class" คอลัมน์ I จะได้ผลลัพธิ์ตามปกติ
แต่ถ้ากดปุ่มมาโครที่อยู่ในหน้าชีท "Second Last" ผลลัพธิ์ในคอลัมน์ I ไม่ขึ้นแสดงครับ
ติดแถบเหลืองที่บรรทัดนี้ sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value

Code: Select all

Sub I_To_P2()
Application.ScreenUpdating = False
With Sheets("7 Class")
    Dim rng As Range
        Set rng = [E5]
        Dim I As Integer
        I = 0
        Do Until rng.Offset(I, 0).Value = ""
        rng.Offset(I, 0).Select
        Dim sel As Range
        Set sel = [I5]
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
    End With
Application.ScreenUpdating = True
End Sub

[snasui]

ปัญหาคือ ถ้ากดปุ่มมาโครในหน้าชีท "7 Class" คอลัมน์ I จะได้ผลลัพธิ์ตามปกติ
แต่ถ้ากดปุ่มมาโครที่อยู่ในหน้าชีท "Second Last" ผลลัพธิ์ในคอลัมน์ I ไม่ขึ้นแสดงครับ

ที่เป็นเช่นนั้นเพราะมี Code ที่ระบุเซลล์ที่ไม่ได้ระบุว่าเป็นของชีตใดครับ ยกตัวอย่างเช่น Set rng = [E5] หากคลิกเลือกชีต 7 Class ก่อน Run Code ก็จะหมายถึง E5 ของชีต 7 Class และหากคลิกเลือกชีต Second Last ก่อน Run Code ก็จะหมายถึง E5 ของชีต Second Last

ดังนั้น การอ้างถึง Object ใด ๆ ใน Excel ให้าคำนึงถึงกรณีนี้เสมอ คือจะต้องระบุว่าเป็นเซลล์ของชีตใด หากทำงานข้ามไฟล์ก็ต้องระบุว่าเป็นของชีตใด ไฟล์ใด เข้าไปด้วยครับ

เช่นระบุเป็น Set rng = Worksheets("7 Class").Range("E5") เป็น ต้น

[aroydee]

เข้าใจละครับ
ขอถามครับ...
ตรงที่กำหนด With Sheets("7 Class") ตรงนี้ยังไม่ครอบคลุมใช่ไหมครับ
แล้วสามารถลบบรรทัดนี้เลยได้ไหมครับ

[aroydee]

พอคีย์ {W} หรือ {L} ในหน้าชีท ("Second Last") มันขึ้น bug ดังรูปที่แนบมาครับ

Code: Select all

Sub I_To_P()
Application.ScreenUpdating = False
    With Sheets("7 Class")
    Dim rng As Range
    Set rng = Worksheets("7 Class").Range("E5")
    Dim I As Integer
    I = 0
        Do Until rng.Offset(I, 0).Value = ""
        rng.Offset(I, 0).Select
    Dim sel As Range
    Set sel = Worksheets("7 Class").Range("I5")
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
    End With
Application.ScreenUpdating = True
End Sub

[aroydee]

ถ้าแก้เป็นแบบนี้ ได้ยุครับ
แต่ไม่รู้ว่าถูกต้องตามหลักการหรือเปล่า

Code: Select all

Sub I_To_P()
Application.ScreenUpdating = False
    Dim rng As Range, sel As Range
    Set rng = Worksheets("7 Class").Range("E5")
    Dim I As Integer
    I = 0
        Do Until rng.Offset(I, 0).Value = ""
        Sheets("7 Class").Select
        rng.Offset(I, 0).Select
    Set sel = Worksheets("7 Class").Range("I5")
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
        Sheets("Second Last").Select
Application.ScreenUpdating = True
End Sub

[snasui]

เมื่อทดสอบแล้วไม่แสดงผลผิดพลาดก็ถือว่าใช้ได้ครับ

[aroydee]

แต่มีข้อเสียตรง ไม่ว่าจะทำงานอยู่หน้าไหน พอกดคีย์ {W} หรือ {L} มันก็จะเด้งไป
อยู่ที่หน้าชีท ("Second Last") ตลอดครับ
น่าจะเป็นเพราะบรรทัดนี้ Sheets("Second Last").Select
แต่ถ้าไม่มี มันก็เด้งไป ("7 Class") ตลอดเหมือนกันครับ
ถ้าจะไม่ให้เป็นแบบนี้ ควรแก้ยังไงครับ

[snasui]

ไม่ให้ย้ายไปชีตไหนก็ตัดลบบรรทัดที่ให้ Select ชีตนั้นออกครับ

[aroydee]

อาจารย์ครับ มีคำสั่งที่ให้อยู่ในหน้าชีทที่ทำงานปัจจุบัน
ก่อน End Sub ไหมครับ

[snasui]

ใช้คำสั่ง Select เพื่อให้อยู่หน้าปัจจุบันหรือหน้าไหนก็ได้ตามต้องการ คำสั่งนี้ใช้เมื่อจำเป็นครับ

แต่เดิมถ้า Select เยอะหน้าจอก็จะวูบวาบ Code จะทำงานช้า ปัจจุบัน Microsoft ได้ปรับเรื่องนี้ให้มีการทำงานที่เร็วขึ้นด้วยครับ