อยากใช้ VBA สร้าง function

[picpostman]

มีเรื่องรบกวนครับ ตอนนี้ผมกำลังทำ report เกี่ยวกับ Permission file sharing โดย
ผมรับค่าจาก B2-B7 เป็นค่า permission แล้วนำไปแทนค่าเป็นตัวเลข
D=5
F=4
M=3
RW=2
R=1
N=0

แล้วส่งค่ากลับ โดยเอาค่ามากสุดมากแสดงที่ B8

วิธีดังกล่าวยุ่งยากมากครับเพราะ จำนวนข้อมูลเยอะมาก ของจริงมีมากกว่า 6 group
ผมอยากใช้ vba สร้างเป็น function โดยใช้ mouse ลากจากช่อง B2-B7 แล้วได้ผลลัพ ที่ช่อง B8 ทำได้ไหมครับ
ปล. จากไฟล์ที่แนบ ช่อง "คำนวณเท่านั้น" เอาออกก็ได้ครับ ถ้าใช้ IF เปรียบเทียบ permission ได้โดยตรงน่าจะดีกว่า
ขอบคุณครับ

[snasui]

กรณีใช้สูตรและไม่ใช้เซลล์ช่วย ที่เซลล์ B7 คีย์

=INDEX({"N";"R";"RW";"M";"F";"D"},MATCH(MAX(IF(ISNUMBER(MATCH({"N";"R";"RW";"M";"F";"D"},$B$2:$B$7,0)),{0;1;2;3;4;5})),{0;1;2;3;4;5},0))

Enter

แต่หากต้องการใช้ VBA ลองเขียนมาก่อนครับ ติดตรงไหนก็ค่อยมาช่วยกันดูต่อ

[picpostman]

สวัสดีครับ ผมได้ลองเขียน function แล้วครับ (เพิ่งไปซื้อหนังสือเมื่อเย็นมาหัดเขียน กว่าจะได้ตีสีเลยครับ)
ผมเขียนเสร็จแล้วแต่ออกแนวลูกทุ่งไปหน่อยมั้งครับ แต่ก็พอใช้งานได้ อาจารย์จะช่วยเสริม ก็ยินดีครับ

แต่ผมติดปัญหาเรื่องการเรียกใช้งาน เมื่อ user มีจำนวน group ไม่เท่ากัน จะใช้เมาส์ลากรวมทีเดียวไม่ได้
ต้องใช้วิธีลากทีละ User ซึ่งเยอะมากครับ
มีวิธีไหนช่วยได้บ้างไหมครับ

มีไฟล์แนบมาด้วยครับ sheet2 (update)

ปล. สูตรแรกที่อาจารย์เขียนมา สุดยอดมากทดลองแล้วครับ

[snasui]

ปกติการใช้ฟังก์ชั่นจะสามารถระบุช่วงข้อมูลที่แน่นอนมาใช้

สำหรับโจทย์นี้ผมเขียนตัวอย่างเป็น Sub Procedure มาให้ตามด้านล่าง ก่อน Run ให้ย้าย User1 มาไว้ที่ A2 ก่อน เพื่อให้เหมือนกับช่วงอื่น ๆ

Code: Select all

Sub SumPern()
Dim a As Variant, b As Variant
Dim k As Integer, i As Integer
Dim t As Integer, u As Integer
Dim r As Range, ra As Range
Dim rl As Range, rall As Range
a = Array("N", "R", "RW", "M", "F", "D")
b = Array(0, 1, 2, 3, 4, 5)
With ActiveSheet
    Set rall = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    For Each rl In rall
        u = 0
        If rl = "Sum-Perm" Then
            k = rl.Row - rl.Offset(0, -1).End(xlUp).Row
            Set ra = rl.Offset(-k, 1).Resize(k, 1)
            For Each r In ra
                For i = 0 To UBound(a)
                    If r = a(i) Then
                        t = b(i)
                    End If
                    If t >= u Then
                        u = t
                    End If
                Next i
            Next r
            rl.Offset(0, 1) = a(u)
        End If
      Next rl
End With
End Sub

[picpostman]

สวัสดีครับ
ผมทดลองของอาจารย์ แล้วใช้งานได้ครับ อ่าน code แล้ว advance มากเลยครับ

แต่ติดปัญหาอีกแล้วครับ เพราะแนวนอน (permission) จะได้แค่อันเดียว ต้องขอโทษจริงๆ ผมบอกข้อมูลไม่ครบ เพราะ permission มีมากกว่า 1 น่ะครับ
ต้องปรับ code ของอาจารย์ตรงไหนถึงจะได้ มากกว่า 1 column ครับ เช่น 10 column

ปล. ถ้าเป็น function ที่ผมเขียนจะใช้เมาส์ลากแนวนอน ได้เลย แต่มันก็ติดตรงแนวตั้งที่ไม่ได้อีก

เพิ่มไฟล์แนบ แบบ permission หลาย column
ขอบคุณมากครับ

[snasui]

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

Code: Select all

Public Sub SumPern()
Dim a As Variant, b As Variant
Dim k As Integer, i As Integer
Dim t As Integer, u As Integer
Dim r As Range, ra As Range
Dim rl As Range, rall As Range
Dim j As Integer
a = Array("N", "R", "RW", "M", "F", "D")
b = Array(0, 1, 2, 3, 4, 5)
With ActiveSheet
    Set rall = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    For Each rl In rall
        If rl = "Sum-Perm" Then
            k = rl.Row - rl.Offset(0, -1).End(xlUp).Row
            For j = 0 To 3
                u = 0
                t = 0
                Set ra = rl.Offset(-k, 1 + j).Resize(k, 1)
                For Each r In ra
                    For i = 0 To UBound(a)
                        If r = a(i) Then
                            t = b(i)
                        End If
                        If t >= u Then
                            u = t
                        End If
                    Next i
                Next r
                rl.Offset(0, j + 1) = a(u)
            Next j
        End If
      Next rl
End With
End Sub

[picpostman]

ขอโทษอีกครั้ง เพราะตอนแรกผมจะใช้ fucntion โดยใช้ เมาส์ลาก เลยไม่ได้แจ้งว่ามีมากกว่า 1 column
ผมกำลังเปิดหนังสือ ดูเรื่อง offset อยู่ครับ เพราะลองปรับด้วยตนเอง ยังได้ไม่หมด
ปล. อาจารย์ตอบไวมากเลยครับ

ผมขอไปลองของอาจารย์อีกทีครับ

[snasui]

ผมปรับ Code ด้านบนใหม่อีกรอบเนื่องจากคีย์ตกไปบางตัวเลยทำให้ครั้งแรกยังให้ผลไม่ถูกต้อง ลองทดสอบดูได้เลยครับ

[picpostman]

ทดลองแล้วครับ ใช้งานได้ทุก row และ column

ขอบคุณจากใจจริงอีกครั้งครับ ผมจากคนที่ไม่เคยเขียน vba มาก่อนเลย ทำให้ได้ความรู้เยอะมากเลยครับ
นับถือน้ำใจของท่าน ที่ยอมสละเวลามาให้ความช่วยเหลือ

ปล. อาจารย์ เทพมาก (สุดๆ)

[snasui]

ยินดีด้วยครับ และขอบคุณสำหรับคำชื่นชมครับ