Quarta-feira, 13 2022 julho
  3 Respostas
  5.9 mil visitas
0
Votos
desfazer
Modifiquei a função subject para remover seleções existentes ao reselecioná-las e remover ;'s extras. Segue o código revisado:

Private Sub Worksheet_Change (ByVal Target As Range)
'Atualizado por Extendoffice 2019/11/13
'Atualizado por Ken Gardner 2022/07/11
Dim xRng como intervalo
Dim xValue1 como string
Dim xValue2 como string
Dim semiColonCnt como inteiro
Se Target.Count > 1, então Exit Sub
On Error Resume Next
Definir xRng = Cells.SpecialCells(xlCellTypeAllValidation)
Se xRng não for nada, saia do sub
Application.EnableEvents = False
'Se não for Application.Intersect(Target, xRng) não é nada então
Se Application.Intersect(Target, xRng) Then
xValue2 = Alvo.Valor
Aplicativo.Desfazer
xValue1 = Alvo.Valor
Alvo.Valor = xValue2
Se xValue1 <> "" Então
Se xValue2 <> "" Então
Se xValue1 = xValue2 Ou xValue1 = xValue2 & ";" Ou xValue1 = xValue2 & "; " Então 'deixe o valor se apenas um na lista
xValue1 = Replace(xValue1, "; ", "")
xValue1 = Replace(xValue1, ";", "")
Alvo.Valor = xValue1
ElseIf InStr(1, xValue1, "; " & xValue2) Then
xValue1 = Replace(xValue1, xValue2, "") ' remove o valor existente da lista ao repetir a seleção
Alvo.Valor = xValue1
ElseIf InStr(1, xValue1, xValue2 & ";") Then
xValue1 = Replace(xValue1, xValue2, "")
Alvo.Valor = xValue1
Outro
Target.Value = xValue1 & "; " & xValue2
Se acabar
Target.Value = Replace(Target.Value, ";;", ";")
Target.Value = Replace(Target.Value, "; ;", ";")
If InStr(1, Target.Value, "; ") = 1 Then ' check for ; como primeiro caractere e remova-o
Target.Value = Replace(Target.Value, "; ", "", 1, 1)
Se acabar
If InStr(1, Target.Value, ";") = 1 Then
Target.Value = Replace(Target.Value, ";", "", 1, 1)
Se acabar
semivírgulaCnt = 0
Para i = 1 Para Len(Target.Value)
If InStr(i, Target.Value, ";") Então
semiColonCnt = semiColonCnt + 1
Se acabar
Proximo eu
If semiColonCnt = 1 Then ' remove ; se último caractere
Target.Value = Replace(Target.Value, "; ", "")
Target.Value = Replace(Target.Value, ";", "")
Se acabar
Se acabar
Se acabar
Se acabar
Application.EnableEvents = True
End Sub
1 ano atrás
·
#2872
0
Votos
desfazer
Olá Ken Gardner,

Obrigado pela sua partilha. Você se importa se adicionarmos seu código VBA ao nosso tutorial: Como criar uma lista suspensa com várias seleções ou valores no Excel?

Estou ansioso para ouvir de você. :)

Amanda
1 ano atrás
·
#2879
0
Votos
desfazer
Oi Amanda, por todos os meios vá em frente. Eu peguei o código original de ExtendOffice.
Abraço, Ken
1 ano atrás
·
#2882
0
Votos
desfazer
Saúde Ken :D
  • Página :
  • 1
Ainda não há respostas para esta postagem.