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

[aroydee]

1.เมื่อป้อนตัวเลขตามหน้าไพ่ แล้วกดบันทึกแต้ม คอลัมน์ L จะแสดงผลฝั่งที่แต้มมากกว่า
2.ต้องการแสดงผลเป็นตาราง แต่ที่เคยทำ ต้องเอาผลแพ้ชนะมาจากการกดปุ่มมาโครโดยตรง คือสร้างปุ่มมาอีกชุด (แต่เสียเวลาทำให้เกมล่าช้า)
ถ้าเอาผลมาจากคอลัมน์ L โดยตรง ตารางไม่ขึ้น
3.ต้องการสร้างคอลัมน์ใหม่ให้แสดงผลเหมือน L โดยอ้างอิงจาก L นำมาเขียนเป็นคำสั่ง VBA จะได้ไหมครับ

[aroydee]

ไฟล์ตัวอย่างครับ

[aroydee]

หรือมีวิธีการเขียนตารางแสดงผลอย่างอื่นไหม
ตาราง...ในคอลัมน์จะแสดงผลที่เหมือนกัน
ถ้าผลออกไม่เหมือนเดิม ก็ขึ้นคอลัมน์ใหม่

[snasui]

ตอบโดยรวบยอด VBA ทำได้แทบทุกสิ่งทุกอย่างครับ

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

กรณีอ้างถึงวัถตุหรือเซลล์ ควรระบุถึงชื่อหรือตำแหน่งให้ชัดเจนจะได้เข้าใจตรงกันครับ

[aroydee]

เกมไพ่มหาสนุก...(ฝึกบวกเลข ใน 1 เกม มีประมาณ 60 ตา)
ที่ทำแล้ว....
Module 1 คือ กำหนดแป้นใส่ตัวเลขฝั่งสีน้ำเงินในแต่ละตาๆละ 3 ตัว
Module 2 คือ กำหนดแป้นใส่ตัวเลขฝั่งสีแดง......
Module 3 คือ แป้นเริ่มเกมใหม่, แป้นบันทึกแต้ม, แป้นลบแต้ม
ที่กำลังทำ...
Module 4 คือ โมดูลที่จะสร้างใหม่ โดยผลจะแสดงในคอลัมน์ ScoreBR เซลล์ AN3:AN79
... เมื่อโมดูล 3 สั่งบันทึกแต้มเสร็จ ก็จะได้ผลลัพธ์เป็น B หรือ R (ที่แต้มรวมมากกว่า)
แสดงในคอลัมน์ L ตั้งแต่เซลล์ที่ L19:L79 ทีละตา จนครบ 60 ตา
จุดมุ่งหมายของโมดูล 4 คือ คัดลอกเซลล์ในคอลัมน์ L ไปไว้ที่คอลัมน์ AN ทีละตา จนจบเกมที่ 60 ตา
ความจริงเขียนสูตรในเซลล์ง่ายกว่า แต่...คำสั่งในขั้นต่อไปที่จะสร้างตาราง มันไม่ทำงานครับ
มันจะทำงานเมื่อรับตัวแปรมาจาก VBA ครับ
ดังนั้น ขอคำสั่ง VBA ที่คัดลอกเซลล์ตรงนี้ก็พอครับ และพอโมดูล 3 ทำงานเสร็จก็ให้โมดูล 4 ทำงานต่อเลย ไม่ต้องกดแป้นมาโคร
เดี๋ยวแนบไฟล์ให้ใหม่ครับ

[aroydee]

ไฟล์ใหม่

[aroydee]

ผมลองแก้ใน Module 3 ใน Sub AddScore() แล้วมันไม่คัดลอกไปทีละตัวครับ
มันไปทั้ง L19:L79 ยกชุดเลย

[snasui]

ช่วยเล่าเฉพาะ Module3 ว่ามีขั้นตอนอย่างไร เช่น กรอกค่าใด คลิกปุ่มไหน อย่างเป็นขั้นเป็นตอน

ผลลัพธ์ที่ต้องการหากว่า Code ทำงานถูกต้อง จะได้ช่วยทดสอบได้ครับ

[aroydee]

1.ไพ่แบ่งเป็น 2 สี Blue, Red ฝั่งละ 3 ใบ (ทดสอบ..ใส่เลขอะไรก็ได้ครับ 0-9 ฝั่งน้ำเงิน 3 ตัว แดง 3 ตัว) คือ Module1 + Module2
2.เมื่อใส่เลขครบแล้วกดแป้น [บันทึกแต้ม] คือ Module3 ก็จะได้ผลในคอลัมน์ L ครับ
นี่คือ 1 ตา

[aroydee]

Code: Select all

Sub AddScore()
    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
        Range("PS").ClearContents
        Range("BS").ClearContents
    Dim i As Integer
    Dim sel As Range
    Set sel = [L19:L79]
        For i = 1 To 60
            Range("i").Copy
            Range("AN" & Columns.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        Next i
    End With
    Application.CutCopyMode = False
End Sub

[aroydee]

ที่ลองเพิ่มคือ ตั้งแต่ บรรทัดที่ 13 ครับ

[snasui]

ที่ลองเพิ่มคือ ตั้งแต่ บรรทัดที่ 13 ครับ

ขอทราบผลลัพธ์ของคำสั่งนี้ครับ

ต้องการให้แสดงผลตรงไหน อย่างไร ผมต้องการทราบผลลัพธ์ของคำสั่งตามโพสต์ #10 ครับ

[aroydee]

แสดงผลในคอลัมน์ AN เซลล์ AN3:AN79
สมมุติ
ตาที่ 1 ผลคอลัมน์ L เซลล์ L19 ได้เป็น R ก็ให้คัดลอก R ไปเซลล์ AN3
ตาที่ 2 ผลคอลัมน์ L เซลล์ L20 ได้เป็น B ก็ให้คัดลอก B ไปเซลล์ AN4
ตาที่ 3 ผลคอลัมน์ L เซลล์ L21 ได้เป็น B ก็ให้คัดลอก B ไปเซลล์ AN5
.......
ไปแบบนี้เรื่อยๆ ครับ

[snasui]

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

Code: Select all

Sub AddScore()
    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
        Range("an" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
            Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value
        Range("PS").ClearContents
        Range("BS").ClearContents
    End With
    Application.CutCopyMode = False
End Sub

ควร Clear ค่าในคอลัมน์ AN ที่ได้จากการทดสอบ Code เดิมทิ้งไปเสียก่อนเพราะผลจาก Code เดิมอาจจะมีบางค่าวางอยู่ด้านล่าง ๆ ของคอลัมน์ N ครับ

[aroydee]

ขอบคุณครับ
ช่วยอธิบายหน่อยครับ ทำไมบรรทัดที่ 2 จึงใช้ "f"

Code: Select all

        Range("an" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
            Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value
        Range("PS").ClearContents
        Range("BS").ClearContents
    End With
    Application.CutCopyMode = Fals

[snasui]

Code นั้นนำค่าในคอลัมน์ที่ 6 ถัดจากคอลัมน์ F ไปใช้ในคอลัมน์ AN และไม่จำเป็นต้องเริ่มจาก F ขอให้หาบรรทัดสุดท้ายที่มีข้อมูลเพื่ออ้างอิงไปยังค่าเป้าหมายที่จะนำใช้ให้ได้ก็พอครับ

ที่เริ่มจาก F เพราะคอลัมน์ที่ 6 ถัดจาก F (คอลัมน์ที่จะนำค่าไปใช้) เป็นสูตรที่เขียนเอาไว้ล่างหน้า ใช้การอ้างอิงจากล่างขึ้นบนแบบกรณีทั่วไปไม่ได้ครับ

[aroydee]

ขอบคุณครับ
รู้ที่มาที่ไป ก็จะสามารถนำไปดัดแปลงใช้ได้ครับ

[aroydee]

มีปัญหาเพิ่มครับ...จากที่เมื่อวานให้คัดลอกทุกตัว
แต่ตอนนี้อยากแก้เป็น ... ตาไหน ถ้าแต้มทั้ง 2 ฝั่งเท่ากัน (Tie หรือ T)ไม่ต้องคัดลอกสกอร์หรือผลลัพธิ์ได้ไหมครับ
คือถ้าเสมอ ให้คอลัมน์ AN แสดงเท่าเดิม ตาต่อมาถ้ามีฝ่ายชนะค่อยคัดลอกต่อ ถ้าเสมออีกก็ไม่ต้องคัดลอก

Code: Select all

Sub AddScore()
    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
        Range("an" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
            Range("f" & Rows.Count).End(xlUp).Offset(0, 6).Value
        Range("PS").ClearContents
        Range("BS").ClearContents
    End With
    Application.CutCopyMode = False
End Sub

[snasui]

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

Code: Select all

'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

[aroydee]

มันขึ้นแบบนี้ครับ