Excel VBA - объединение нескольких изменений выбора листа - PullRequest
0 голосов
/ 01 апреля 2019

Я новичок в vba, пытаюсь разобраться с таблицей, над которой я работаю.

У меня есть два кода, которые работают по отдельности, но мне сложно их комбинировать. Есть идеи, как лучше их объединить?

Первый код - открыть диалоговое окно, когда я нажимаю на столбец 18.

Второй код предназначен для выбора нескольких вариантов выбора из выпадающего списка проверки. По этой ссылке: https://trumpexcel.com/select-multiple-items-drop-down-list-excel/

Мне также интересно применить второй код к нескольким столбцам, возможно ли это каким-то образом?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 17 Then
        ActiveSheet.Shapes("Rectangle 3").Visible = True
        ActiveSheet.Shapes("Rectangle 2").Visible = True
        ActiveSheet.Shapes("Rectangle 2").TextFrame.Characters.Text = Range("A" & (ActiveCell.Row)) & " - " & Range("B" & (ActiveCell.Row))
        With ActiveSheet.Shapes("Rectangle 3")
            .Left = Target.Offset(, 1).Left
            .Top = Target.Offset(0).Top
        End With
        With ActiveSheet.Shapes("Rectangle 2")
            .Left = Target.Offset(0, 2).Left
            .Top = Target.Offset(0, 0).Top
        End With
    Else
        ActiveSheet.Shapes("Rectangle 3").Visible = False
        ActiveSheet.Shapes("Rectangle 2").Visible = False
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 12 Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ";" & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Заранее спасибо за любую помощь!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...