การกำหนดตำแหน่งทศนิยมให้กับcell แต่ละcell โดยไม่ใช้ Menu bar

[Panuwat]

เรียนท่านอาจารย์ครับ ผมมีปัญหาจะเรียนถามท่านอาจารย์ เกี่ยวกับการกำหนดตำแหน่งทศนิยมให้กับcell แต่ละcell โดยไม่ใช้ Menu barดังนี้ครับ
เมื่อกำหนดตัวชี้วัด ซึ่งแต่ละสาขาจะกำหนดไม่เหมือนกัน ทำให้แต่ละ KPI มีหน่วยที่ต่างกัน ตำแหน่งทศนิยมในแถวนั้นๆ ต่างกัน ผมต้องการให้ ตำแหน่งทศนิยมในช่องคีย์ผลงานของพนักงานแต่ละคนปรับเปลี่ยนไปตามการกำหนด kpi ใน Sheet ตัวชี้วัด โดยไม่ต้องการให้ มีการใช้ tool ตรงเมนู บาร์ มาเกี่ยวข้องครับ ซึ่งแต่ละ cell นั้น มีทั้ง cell ที่ถูก Lock และไม่ถูก Lock ครับ

ข้อมลเพิ่มเติม
1.กำหนดข้อมูล KPI หน่วย ตำแหน่งทศนิยม จาก Sheet ตัวชี้วัด
2.คือ Sheet ของพนักงานแต่ละคน ใช้สำหรับคีย์ผลงานที่ทำได้ในแต่ละเดือน



ขอแสดงความนับถือ

[snasui]

การทำเช่นนั้นคงต้องพึ่ง VBA ครับ

ผมเขียน Code มาให้เป็นตัวอย่างตามด้านล่าง ลองทดสอบดูครับ

Code: Select all

Sub RangeNunFormat()
Dim r As Range, sh As Worksheet
Dim rAll As Range, i As Integer
On Error Resume Next
For Each sh In Worksheets
    If sh.Name <> "ตัวชี้วัด" Then
    Set rAll = sh.Range("B6:B25")
        For Each r In rAll
            i = Application.VLookup(r, Worksheets("ตัวชี้วัด").Range("B5:D24"), 3, 0)
            If i > 0 Then
                r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0." & String(i, "0")
            Else
                r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0"
            End If
        Next r
    End If
Next sh
End Sub

[Panuwat]

เรียนท่านอาจารย์ ผมได้ทดลองนำ code ที่ท่านอาจารย์เขียน นำไปวางใน Module แล้ว แต่ก็ไม่มีอะไรเกิดขึ้นครับ ไม่ทราบว่าผมทำอะไรผิดหรือปล่าวครับ

[snasui]

ลองใส่ตัวเลขลงในแต่ละชีทและลองเปลี่ยนตำแหน่งทศนิยมแล้ว Run Code ดูครับ ผมทดสอบแล้ว Code ทำงานได้ไม่มีปัญหา และ Code นี้เปลี่ยน Format ให้ทุกชีทในคราวเดียวครับ

การ Locked หรือไม่ Locked เซลล์จะยังไม่มีผล ยกเว้นมีการ Protect เอาไว้ ซึ่งเมื่อ Protect ไว้แล้วก็จะต้องปลดการ Protect ก่อนแล้วค่อยจัด Format จากนั้น Protect เอาไว้ใหม่ ซึ่งการทำเช่นนั้นสามารถเขียนด้วย Code VBA เสริมเข้าไป ดูที่นี่เป็นตัวอย่างครับ http://www.snasui.com/viewtopic.php?p=2188#p2188

[Panuwat]

เรียนท่านอาจารย์ครับ ตาม code
If sh.Name <> "ตัวชี้วัด" Then Set rAll = sh.Range("B6:B25")
For Each r In rAll
i = Application.VLookup(r, Worksheets("ตัวชี้วัด´").Range("B5:D24"), 3, 0)
If i > 0 Then
r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0." & String(i, "0")
Else
r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0"
End If
Next r
End If

หมายความว่า ให้ทำตามเงื่อนไข กับทุกชีตที่ไม่ได้ชื่อชีต "ตัวชี้วัด" แต่ถ้าในกรณีที่ ไฟล์จริงที่ทำมีชีตหลายชีต แต่ละชีตมีการทำงานไม่เหมือนกัน แต่เผมต้องการให้เงื่อนไขนี้ทำงานในชีตที่ชื่อว่า "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" (มีพนักงานที่จะประเมินมาก)
จึงขอความกรุณาอาจารย์ให้คำแนะนำด้วยครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub RangeNumFormat()
Dim r As Range, sh As Worksheet
Dim rAll As Range, i As Integer
On Error Resume Next
For Each sh In Worksheets
    Select Case Val(sh.Name)
    Case 1 To 13
    Set rAll = sh.Range("B6:B25")
        For Each r In rAll
            i = Application.VLookup(r, Worksheets("ตัวชี้วัด").Range("B5:D24"), 3, 0)
            If i > 0 Then
                r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0." & String(i, "0")
            Else
                r.Offset(0, 4).Resize(, 16).NumberFormat = "#,##0"
            End If
        Next r
    End Select
Next sh
End Sub