ปรึกษาเรื่อง Dropdown list ไม่ให้แสดงค่าใน Dropdown list ที่เราเคยเลือกไปแล้ว

[kopao]

ปรึกษาเรื่อง Dropdown list ไม่ให้แสดงค่าใน Dropdown list ที่เราเคยเลือกไปแล้ว

เช่นข้อมูลมี นายกอ นายขอ นายคอ
ถ้ากด Dropdown list เลือกนายกอเป็นบันทัดแรก บันทัดต่อมา เวลากด Dropdown list จะเหลือแค่ นายขอ กับ นายคอ ให้เลือกได้เปล่าครับ

ขอบคุณมากครับ

[logic]

ทำได้ ช่วยแนบไฟล์มาด้วยจะสะดวกกับการตอบครับ

[kopao]

แนบให้แล้วครับ ขอบพระคุณมากครับ

[Supachok]

input data A:D
a b c 1
b c a 2
c a b 3

E1
Data validation > list > select (A1:A3)
E2
=OFFSET($A$1,MATCH(E1,$A$1:$A$3,0)-1,1,,ROW($A$2)-ROW(A2)+2)
E3
=CHOOSE(VLOOKUP(E2,A1:D3,4,0)+VLOOKUP(E1,A1:D3,4,0),"","","c","b","a")

[kopao]

ขอบคุณทุกท่านมากๆ เลยครับ

[Bo_ry]

F1 ลากลง
=IFERROR(INDEX($A:$A,AGGREGATE(15,6,ROW($A$1:$A$99)/NOT(COUNTIF($D$1:$D$99,$A$1:$A$99))/($A$1:$A$99<>""),ROWS(F$1:F1))),"")

Data Validation list
=OFFSET($F$1,,,COUNTIF(F:F,"*?"))

[snasui]

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

1. เซลล์ B1 คีย์
   =INDEX($A$1:$A$3,SMALL(IF(ISNA(MATCH($A$1:$A$3,$D$1:$D$300,0)),ROW($A$1:$A$3)-ROW($A$1)+1),ROWS(B$1:B1)))
   Ctrl+Shift+Enter > Copy ลงด้านล่าง
2. ตรง Validation คีย์สูตร
   =OFFSET($B$1,0,0,COUNTIF($B:$B,"*"))

[kopao]

ขอบคุณมากครับ

[kopao]

ขอถามเพิ่มหน่อยครับ เนื่องจากรายการใน drop downl list มีจำนวนมาก พิมพ์ตัวอักษรตัวแรกเข้าไปเพื่อให้แสดงเฉพาะข้อความที่เกี่ยวข้องได้เปล่าครับ หรือให้ drop downl list เลื่อนไปอยู่ข้อความที่เกี่ยวข้องก็ได้ครับ ตัวอย่างในรูปที่แนบมาครับ

[snasui]

แบบนั้นต้องใช้ VBA เข้ามาช่วย ไม่สามารถทำได้ด้วยวิธีปกติลองดูที่นี่เป็นแนวทางครับ https://www.snasui.com/viewtopic.php?f=3&t=10871

[kopao]

ทำได้แล้วครับ ขออนุญาติถามเพิ่มหน่อยครับ

-ใน Dropdown List เวลาเราพิมพ์ข้อความลงไปเอง ถ้าไม่มีอยู่ใน List จะขึ้น error แต่ใน VBA พิมพ์ข้อความที่ไม่อยู่ใน List ลงไป ไม่แจ้ง error ไม่ทราบว่าต้องเพิ่ม Code อะไรลงไปบ้างครับ

-เวลา Save Excel จะบังคับให้ Save แมโคร ถ้าเราเซฟไฟล์ใหม่เป็นแบบ แมโคร แล้วไฟล์เก่าทิ้งได้เลยหรือเปล่าครับ จำเป็นต้องเก็บไว้หรือเปล่าครับ

[snasui]

แนบไฟล์พร้อม Code ล่าสุดมาด้วยพร้อมแจ้งว่าคีย์ค่าใด จะได้สะดวกในการตรวจสอบครับ

[kopao]

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

Code: Select all

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
'move to next cell on Enter and Tab
Dim varVal As Variant
On Error Resume Next
 'change text value to number, if possible
varVal = --ActiveCell.Value
If IsEmpty(varVal) Then
  varVal = ActiveCell.Value
End If

Select Case KeyCode
  Case 9  'tab
    ActiveCell.Value = varVal
    ActiveCell.Offset(0, 1).Activate
  Case 13 'enter
    ActiveCell.Value = varVal
    ActiveCell.Offset(1, 0).Activate
  Case Else
    'do nothing
End Select

End Sub

Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet

Set ws = ActiveSheet
Set wsList = Sheets("ValidationSample")
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
   Cancel = True
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub

[snasui]

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

Code: Select all

Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
    'move to next cell on Enter and Tab
    Dim varVal As Variant
    On Error Resume Next
     'change text value to number, if possible
    varVal = --ActiveCell.Value
    If IsEmpty(varVal) Then
      varVal = ActiveCell.Value
    End If
    
    Select Case KeyCode
      Case 9  'tab
        If Application.CountIf(Worksheets("ValidationLists").Range("c1:c12"), varVal) > 0 Then
            ActiveCell.Value = varVal
            ActiveCell.Offset(0, 1).Activate
        Else
            ActiveCell.ClearContents
            MsgBox "Not match.", vbExclamation
        End If
      Case 13 'enter
        If Application.CountIf(Worksheets("ValidationLists").Range("c1:c12"), varVal) > 0 Then
            ActiveCell.Value = varVal
            ActiveCell.Offset(1, 0).Activate
        Else
            ActiveCell.ClearContents
            MsgBox "Not match.", vbExclamation
        End If
      Case Else
        'do nothing
    End Select

End Sub

[kopao]

ผมลองใส่ code แล้ว ยังคงพิมพ์คำอื่นที่ไม่มีใน list ได้ครับ ไม่รู้ว่าผิดตรงไหนหรือเปล่าครับ

Code: Select all

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
    'move to next cell on Enter and Tab
    Dim varVal As Variant
    On Error Resume Next
     'change text value to number, if possible
    varVal = --ActiveCell.Value
    If IsEmpty(varVal) Then
      varVal = ActiveCell.Value
    End If
    
    Select Case KeyCode
      Case 9  'tab
        If Application.CountIf(Worksheets("ValidationLists").Range("c1:c12"), varVal) > 0 Then
            ActiveCell.Value = varVal
            ActiveCell.Offset(0, 1).Activate
        Else
            ActiveCell.ClearContents
            MsgBox "Not match.", vbExclamation
        End If
      Case 13 'enter
        If Application.CountIf(Worksheets("ValidationLists").Range("c1:c12"), varVal) > 0 Then
            ActiveCell.Value = varVal
            ActiveCell.Offset(1, 0).Activate
        Else
            ActiveCell.ClearContents
            MsgBox "Not match.", vbExclamation
        End If
      Case Else
        'do nothing
    End Select

End Sub

Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet

Set ws = ActiveSheet
Set wsList = Sheets("ValidationLists")
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
   Cancel = True
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub

[snasui]

ในเครื่องผมพิมพ์ค่าที่ไม่มีไม่ได้ครับ

เช่น Double Click เซลล์แล้วคีย์ A ลบค่าอื่น ๆ ด้านหลัง A แล้ว Enter จะขึ้นตามภาพ

[kopao]

รู้แล้วครับ ต้องพิมพ์แล้วกด enter ถึงขึ้น error ครับ ไม่ทราบมีวิธีแก้เปล่าครับ ผมไปพิมพ์แล้วใช้ กดปุ่ม Tab หรือ ใช้ Mouse แทน มันเลยไม่ error

ขอบมากครับ

[snasui]

Code นั้นเจ้าของเขาเขียนไว้ชัดเจนแล้วว่าการเลื่อนไปยังเซลล์อื่นให้ใช้ Enter หรือ Tab หากต้องการจะใช้วิธีคลิกไปยังตำแหน่งอื่น ๆ ให้ลองปรับมาเองดูก่อน ติดตรงไหนค่อยแนบ Code นั้นมาถามกันต่อครับ

[kopao]

ขอบคุณมากครับ เข้าไปอ่าน code อีกรอบ ชัดเจนเลยครับ

[kopao]

รบกวนอีกรอบครับ
ตอนใช้ Validation ใส่ code

Code: Select all

=OFFSET(ValidationLists!$A$1,0,0,COUNTA(ValidationLists!$A:$A)-1,1)

เวลาเลือกข้อมูลจะอยู่บนสุดตลอด แต่ ตัว VBA จะไม่ทำงาน ไม่ทราบว่าเป็นที่อะไรครับ

คืออยากให้เวลากด Dropdown List ลงมาจากบนสุดก่อนครับ ไฟล์ตัวอย่าง คอลัมน์ Weekday ใช้คำสั่ง OFFSET ตัว VBA จะไม่ทำงาน คอลัมน์ Month ไม่ได้ใช้ OFFSET ตัว VBA ทำงานปกติครับ

ขอบคุณครับ