VBA：從多選字段中刪除值

我的工作簿中有一個頁面，其中某些單元格是多選的。用戶可以從下拉列表中選擇值，並將它們附加並格式化，以便將其上傳到我們的系統中。它工作的很好 - 但只有一個問題。目前無法刪除單個值。如果用戶從下拉列表中選擇了錯誤的值，他們將不得不刪除並重新開始。有沒有辦法去除個人價值觀？下面是目前多選擇代碼：VBA：從多選字段中刪除值

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
Dim strSep As String 
Dim strSep2 As String 
Dim header As String 
Dim MatchField As Range 
Dim AnsType As Range 

Application.ScreenUpdating = False 

strSep = Chr(34) & "," & Chr(34) 
strSep2 = "," & Chr(34) 

header = Me.Cells(11, Target.Column).Value 
Set MatchField = ThisWorkbook.Worksheets("User Fields").Range("B16:B100").Find(header) 

If Not MatchField Is Nothing Then 
    Set AnsType = MatchField.Offset(0, 2) 
End If 

Application.EnableEvents = False 
On Error Resume Next 

If Target.Count > 1 Then GoTo exitHandler 

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
On Error GoTo exitHandler 

If rngDV Is Nothing Then GoTo exitHandler 

If Intersect(Target, rngDV) Is Nothing Then 
    'do nothing 
Else 'cell has data validation 
    If InStr(1, AnsType, "Multiple") > 0 Then 'Determines if current column corresponds to a multi-select field 

    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 

    If newVal = "" Then 
     'do nothing 
    Else 
     If oldVal = "" Then 
      Target.Value = newVal 
     ElseIf InStr(1, oldVal, newVal) = 0 Then 
      If InStr(1, oldVal, Chr(34)) > 0 Then 
       Target.Value = oldVal & strSep2 & newVal & Chr(34) 
      Else 
       Target.Value = Chr(34) & oldVal & strSep & newVal & Chr(34) 
      End If 
     Else 
      Target.Value = oldVal 
     End If 
    End If 
    End If 
End If 
Application.ScreenUpdating = True 
exitHandler: 
    Application.EnableEvents = True 
Application.ScreenUpdating = True 
End Sub

來源

2017-10-18 Mknerr

是的，這是可能的，但我無法很快找出你的代碼應該如何工作，因爲我沒有在這裏的整個Excel文件。我有這樣的代碼，但我使用列表框。你能解釋你的代碼應該如何工作嗎？ – Ibo

同上...我認爲你的單元格中有下拉框，每個下拉框都有不同的元素。他可以從不同的下拉菜單中選擇多個元素，這些元素可以格式化並連接在一起發送到另一個系統。對？一旦用戶從特定的下拉列表中選擇了一個項目並將其發送到其他系統，那麼您希望該項目從該下拉列表中移除。你在問什麼？ –

@JohnMuggins不完全，但接近。此頁面上還有另一個子選項（selectionchange事件），它根據另一頁上的列表動態調整數據驗證。假設我的清單是業務單位。當客戶在單元中使用此下拉菜單時，他們可以選擇多個業務單位。該代碼允許他們這樣做，並將它格式化爲「單元1」，「單元2」，它允許我們將數據上傳到我們的網站。我們需要能夠以某種方式取消選擇Unit 2，並將其刪除。直接編輯/刪除不起作用B/C「單元1」不在列表中，單元1是。 – Mknerr

您需要刪除「如果」的聲明，禁止同一項目的雙打能夠從字符串中刪除。嘗試下面的代碼，將雙語聲明註釋掉。

Private Sub Worksheet_Change(ByVal Target As Range) 
    'Updated: 2016/4/12 
    Dim xRng As Range 
    Dim xValue1 As String 
    Dim xValue2 As String 
    If Target.Count > 1 Then Exit Sub 
    On Error Resume Next 
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation) 
    If xRng Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
    If Not Application.Intersect(Target, xRng) Is Nothing Then 
     xValue2 = Target.Value 
     Application.Undo 
     xValue1 = Target.Value 
     Target.Value = xValue2 
     If xValue1 <> "" Then 
      If xValue2 <> "" Then 
'    If xValue1 = xValue2 Or _ 
'     InStr(1, xValue1, ", " & xValue2) Or _ 
        InStr(1, xValue1, xValue2 & ",") Then 
       If InStr(1, xValue1, xValue2 & ",") > 0 Then 
        xValue1 = Replace(xValue1, xValue2 & ", ", "") ' If it's in the middle with comma 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       If InStr(1, xValue1, ", " & xValue2) > 0 Then 
        xValue1 = Replace(xValue1, ", " & xValue2, "") ' If it's at the end with a comma in front of it 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       If xValue1 = xValue2 Then ' If it is the only item in string 
        xValue1 = "" 
        Target.Value = xValue1 
        GoTo jumpOut 
       End If 
       Target.Value = xValue1 & ", " & xValue2 
      End If 
jumpOut: 
     End If 
    End If 
    Application.EnableEvents = True 
End Sub

來源

2017-10-25 15:02:52

我忘了提及：要從target.cell字符串中刪除一個項目，只需從下拉框中再次選擇它即可。它將搜索該項目的字符串並將其從target.cell中刪除（如果找到），或者如果未在instr函數中找到，則將其添加到target.cell。 –

VBA：從多選字段中刪除值

回答

相關問題