ต้องการให้ drop down list เลือกค่าได้หลายค่า

[kaikungzaa]

ต้องการให้ drop down list ของทุกเซลล์ ใน column J เลือกค่าที่กำหนด (ทั่วราช ภาค จังหวัด) ได้หลายค่า หรือ มี checkbox ให้เลือก แล้วส่งค่ากลับไปที่เซลล์นั้นๆ ใน column J ครับ

[parakorn]

ยกตัวอย่างผลลัพท์ที่ต้องการด้วยครับ Database ที่อ้างอิงใน list คืออะไรครับ

[kaikungzaa]

ยกตัวอย่างผลลัพท์ที่ต้องการด้วยครับ Database ที่อ้างอิงใน list คืออะไรครับ

ผลลัพท์ที่ต้องการครับ

[parakorn]

มีหลายวิธีครับ แต่การใช้ Check box หรือ เขียน โค้ด VBA เพื่อ Input ข้อมูล ผู้ถามจะต้องทดลองเขียนมาเองก่อนตามกฏของบอร์ด เพราะการเขียนโปรแกรมเป็นเรื่องที่ผู้ถามจะต้องมีพื้นฐานมาก่อนครับ ส่วนวิธีง่ายๆคือเพิ่มตัวเลือกตรง Database ให้ครอบคลุมในสิ่งที่ต้องการทั้งหมดครับ

[kaikungzaa]

ลองทำดูแล้ว ต้องการแบบนี้ครับ


https://www.img.in.th/images/055274186e ... efe7c5.jpg

[snasui]

ไฟล์ที่แนบมานั้นไม่มี Macro มาด้วย ไฟล์ที่จะมี Macro ได้ต้องมีนามสกุลเป็น .xlsm เป็นอย่างน้อยครับ

[kaikungzaa]

ไฟล์ที่แนบมานั้นไม่มี Macro มาด้วย ไฟล์ที่จะมี Macro ได้ต้องมีนามสกุลเป็น .xlsm เป็นอย่างน้อยครับ

ขอบคุณครับ ผมแนบไฟล์ใหม่แล้ว

ผลลัพท์ที่ต้องการแบบนี้ครับ

https://www.img.in.th/images/055274186e ... efe7c5.jpg

[snasui]

ภาพเล็กมากอ่านแล้วไม่เข้าใจ กรุณาแนบภาพมาที่ฟอรัมนี้แทนการแนบไฟล์ที่อื่นตามกฎการใช้บอร์ดข้อ 4 ด้านบน ไม่เช่นนั้นก็อธิบายประกอบมาในไฟล์แนบ จะได้สะดวกในการทำความเข้าใจครับ

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

1. สร้าง Form Control อาจจะเป็น ListBox มีปุ่ม Close เพื่อคลิกปิด ทำการซ่อน Control นี้ไว้
2. เมื่อคลิกเซลล์ใด ๆ ในพื้นที่ที่กำหนดให้แสดง Form Control ในข้อ 1 ที่เซลล์ด้านบนของเซลล์ที่เลือกหรือตำแหน่งใด ๆ ทีสะดวกกับการเลือก
3. เมื่อผู้ใช้เลือกให้แสดงค่าลงในเซลล์ หากเลือกหลายค่าให้แสดงเครื่องหมายคอมม่าคั่นแต่ละค่า
4. เมื่อเลือกค่าเรียบร้อยแล้วให้คลิกปุ่ม Close ทำการซ่อน Form Control ไว้เช่นเดิม

[snasui]

เนื่องจากการปรับความปลอดภัยให้กับฟอรัมทำให้โพสต์ #9 ที่โพสต์แจ้งมาก่อนหน้านี้โดนลบไป ผมจึงตอบให้ก่อนตามด้านล่าง

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

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lb As Object, i As Integer, lsrng As Range
    Set lb = ActiveSheet.ListBox1
    Set c = Target
    Set lsrng = Range("k2:k4")
    If Not Intersect(Target, Range("j13:j" & Rows.Count)) Is Nothing Then
        With lb
            For i = .ListCount - 1 To 0 Step -1
                .RemoveItem (i)
            Next i
            For i = 0 To lsrng.Count - 1
                .AddItem lsrng(i + 1).Value
            Next i
            .Left = Target.Offset(0, 1).Left
            .Top = Target.Offset(0, 1).Top
            .Visible = True
        End With
    Else
        lb.Visible = False
    End If
End Sub

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

Code: Select all

Public c As Range

Sub Bevel1_Click()
    Dim i As Integer, t As String
    Set lb = Sheets(1).ListBox1
    With lb
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                t = t & ";" & .List(i)
            End If
        Next i
    End With
    c.Value = Mid(t, 2)
End Sub

[kaikungzaa]

ขึ้น error ครับ

[snasui]

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

Module1

Code: Select all

'Other Code...
    If Not Intersect(c, Range("j13:j" & Rows.Count)) Is Nothing Then
        c.Value = Mid(t, 2)
    End If
End Sub

Sheet1

Code: Select all

'Other code...
With lb
    .ListFillRange = ""
    For i = .ListCount - 1 To 0 Step -1
        .RemoveItem (i)
    Next i
    For i = 0 To lsrng.Count - 1
        .AddItem lsrng(i + 1).Value
    Next i
    .Left = Target.Offset(0, 1).Left
    .Top = Target.Offset(0, 1).Top
    .Visible = True
End With
'Other code...

[kaikungzaa]

ต้องการเพิ่มอีกปุ่มครับ

[snasui]

ลองปรับ Code มาเองก่อน ติดแล้วค่อยถามกันต่อครับ

[kaikungzaa]

ลองปรับแล้วก้ยังติดครับ

[snasui]

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

ที่ Sheet1

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lb As Object, i As Integer, lsrng As Range
    Set lb = ActiveSheet.ListBox1
    Set c = Target
    If Target.Column = Columns("j").Column Then
        Set lsrng = Range("j2:j4")
    ElseIf Target.Column = Columns("k").Column Then
        Set lsrng = Range("k2:k4")
    End If
    If Not Intersect(Target, Range("j9:k" & Rows.Count)) Is Nothing Then
        With lb
            .ListFillRange = ""
            For i = .ListCount - 1 To 0 Step -1
                .RemoveItem (i)
            Next i
            For i = 0 To lsrng.Count - 1
                .AddItem lsrng(i + 1).Value
            Next i
                .Left = Target.Offset(0, 1).Left
                .Top = Target.Offset(0, 1).Top
                .Visible = True
        End With
    Else
        lb.Visible = False
    End If
End Sub

ที่ Module1

Code: Select all

Public c As Range

Sub Bevel1_Click()
    Dim i As Integer, t As String
    Set lb = Sheets(1).ListBox1
    With lb
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                t = t & "; " & .List(i)
            End If
        Next i
    End With
        If Not Intersect(c, Range("j9:k" & Rows.Count)) Is Nothing Then
            c.Value = Mid(t, 2)
        End If
End Sub

ทำการ Assign Macro Bevel1_Click ให้กับปุ่มเลือกสีแดง สังเกตว่าทั้งสองปุ่มเราจะให้ Run Code เดียวกัน สามารถลบให้เหลือเพียงปุ่มเดียวก็ได้เช่นกัน