FOR CASE IF... QUAL USAR?

TERABYTES 26/05/2011 23:44:29
#375098
Galera preciso trocar esse código mostruoso por um que busque na array [Ô]User[Ô] User(i) as iniciais dos nomes...
a lista já está criada só preciso substituir esse código por outro...

Antigo código:
Cells(ActiveCell.Row, 10).Select [ô][ô][ô][ô][ô][ô]seleciona a célula desejada
If Application.ActiveCell = [Ô]AL[Ô] Or Application.ActiveCell = [Ô]BE[Ô] Or Application.ActiveCell = [Ô]CL[Ô] Or Application.ActiveCell = [Ô]DA[Ô] Or Application.ActiveCell = [Ô]DE[Ô] Or Application.ActiveCell = [Ô]ED[Ô] Or Application.ActiveCell = [Ô]FR[Ô] Or Application.ActiveCell = [Ô]LE[Ô] Or Application.ActiveCell = [Ô]LU[Ô] Or Application.ActiveCell = [Ô]MA[Ô] Or Application.ActiveCell = [Ô]MO[Ô] Or Application.ActiveCell = [Ô]CA[Ô] Or Application.ActiveCell = [Ô]ML[Ô] Or Application.ActiveCell = [Ô]FT[Ô] Or Application.ActiveCell = [Ô]MF[Ô] Or Application.ActiveCell = [Ô]JA[Ô] Or Application.ActiveCell = [Ô]RB[Ô] Or Application.ActiveCell = [Ô]JP[Ô] Or Application.ActiveCell = [Ô]AJ[Ô] Or Application.ActiveCell = [Ô]TM[Ô] Or Application.ActiveCell = [Ô]SE[Ô] Or Application.ActiveCell = [Ô]LF[Ô] Or Application.ActiveCell = [Ô]DL[Ô] Or Application.ActiveCell = [Ô]CC[Ô] Or Application.ActiveCell = [Ô]SO[Ô] Or Application.ActiveCell = [Ô]CJ[Ô] Or Application.ActiveCell = [Ô][Ô] Then [ô][ô][ô][ô][ô][ô][ô][ô][ô]verifica se contem as iniciais ou espaço em branco, se contem não faz nada
Else
Selection.Delete Shift:=xlToLeft [ô][ô][ô][ô][ô][ô][ô][ô]se não contem exclui a célula
End If [ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô]fim do if


O novo creio eu que fique mais ou menos assim:

for i = 1 to Ubound(User) [ô][ô][ô][ô][ô]conta de 1 até a quantidade de items no User[ô][ô][ô][ô] no caso 18
If Application.ActiveCell = User(i) Or Application.ActiveCell = [Ô][Ô] Then [ô][ô][ô][ô][ô][ô][ô][ô][ô]verifica se contem as iniciais ou espaço em branco, se contem não faz nada
Else
Selection.Delete Shift:=xlToLeft [ô][ô][ô][ô][ô][ô][ô][ô]se não contem exclui a célula
End If [ô][ô][ô][ô][ô]fim do if
next [ô][ô][ô][ô][ô][ô][ô][ô]loop iupiiii
MARCELO.TREZE 27/05/2011 07:34:16
#375108
faz assim usando um mid

Dim Iniciais As String
Iniciais = [Ô]ALBECLDADEEDFRLELUMAMOCAMLFTMFJARBJPAJTMSELFDLCCSOCJ[Ô]
For I = 1 to Len(Iniciais) Step 2
If Application.ActiveCell = Mid(Iniciais,I,2) Or Application.ActiveCell = [Ô][Ô] Then 
[ô] faz o que vc deseja
Else
    Selection.Delete Shift:=xlToLeft [ô][ô][ô][ô][ô][ô][ô]
End If
TERABYTES 27/05/2011 08:08:46
#375109
Mas assim continua do mesmo jeito, sempre que entrar outra pessoa eu vou ter que editar o código e adicionar a inicial.

Na array [Ô]User[Ô] ele puxa de outra tabela as iniciais criando o array User={AL,BE,CL,DA,DE,ED,FR,...,CJ}
E quando alguém adiciona uma nova célula com as iniciais o código já vai assumir como um novo usuário sem ter que editar o código e inserir a inicial.

Valeu pela dica, mas isso ai o meu código faz também.
TERABYTES 02/06/2011 14:39:48
#375690
Alguem tem alguma idéia de como fazer esse [Ô]for[Ô] funcionar??

User = Array(AJ,AL,CA,CL,DA,DE,ED,FR,FT,JA,LU,MF,MO,RB,SE,TQ,CF)

for i = 1 to Ubound(User) [ô][ô][ô][ô][ô]conta de 1 até a quantidade de items no User[ô][ô][ô][ô] no caso 18
If Application.ActiveCell = User(i) Or Application.ActiveCell = [Ô][Ô] Then [ô][ô][ô][ô][ô][ô][ô][ô][ô]verifica se contem as iniciais ou espaço em branco, se contem não faz nada
Else
Selection.Delete Shift:=xlToLeft [ô][ô][ô][ô][ô][ô][ô][ô]se não contem exclui a célula
End If [ô][ô][ô][ô][ô]fim do if
next [ô][ô][ô][ô][ô][ô][ô][ô]loop iupiiii

Essa rotina no primeiro loop já deleta tudo...
KERPLUNK 02/06/2011 15:28:24
#375698
Isso é VBA? Tipo, é o código em uma planilha do excel?
ONBASS 02/06/2011 17:15:52
#375703
tenta assim..

Citação:


Sheets(1).Range([Ô]A1[Ô]).Select
Select Case Selection
Case [Ô]AJ[Ô], [Ô]AL[Ô], [Ô]CA[Ô], [Ô]CL[Ô], [Ô]DA[Ô], [Ô]DE[Ô], [Ô]ED[Ô], [Ô]FR[Ô], [Ô]FT[Ô], [Ô]JA[Ô], [Ô][Ô]
MsgBox [Ô]Texto localizado.[Ô]
Case Else
Selection = [Ô][Ô]
End Select
TERABYTES 02/06/2011 17:28:04
#375707
Olá Kerplunk,

é VBA sim.

O meu primeiro exemplo funciona legal o exemplo do MARCELO-TREZE também funciona.

Só que o array [Ô]User[Ô] já está sendo alimentado automaticamente por uma outra rotina, então sempre que o usuário adicionar uma inicial na planilha de [Ô]Funcionarios[Ô] a rotina já puxa esse dado novo e adiciona no array [Ô]User[Ô].

No meu primeiro exemplo e no exemplo do MARCELO-TREZE eu vou ter que editar o código e adicionar manualmente toda vez que uma nova pessoa tiver que entrar/sair da lista.


flw,
MARCELO.TREZE 02/06/2011 17:32:38
#375708
TeraBytes

assim

de onde vc pretende puxar as iniciais de uma celula do excel seria isso?
TERABYTES 02/06/2011 17:50:28
#375714
DEKINHO,

vlw a dica, mas assim também fica na mesma... Eu vou ter que editar o código para adicionar novos funcionários...

com esse código eu crio a array User da planilha que está em anexo. Com isso eu preciso verificar fazer o que todos os exemplos de vocês fazem... mas ele tem que ler o array User.

No arquivo anexado a coluna [Ô]C[Ô] e [Ô]D[Ô] vão ficar acultas, pq não tem importância para o usuário, nelas eu uso o concatenar pra ficar bunitinho. Na coluna [Ô]A[Ô] o usuário adiciona as iniciais, na [Ô]B[Ô] o nome.

[ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô]botão
Private Sub CommandButton1_Click()
Sheets([Ô]Funcionarios[Ô]).Select
User = CriaListaUser(Range([Ô]D:D[Ô]), True) [ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô]pega os item da coluna D:D e cria o array User
UserNome = CriaListaUser(Range([Ô]C:C[Ô]), True)
End Sub


[ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô][ô]rotina
Private Function CriaListaUser(InputRange As Range, _
HorizontalList As Boolean) As Variant
Dim cl As Range, cUnique As New Collection, i As Long, uList() As Variant
Application.Volatile
On Error Resume Next
For Each cl In InputRange
If cl.Formula <> [Ô][Ô] Then
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl

CriaListaUser = [Ô][Ô]
If cUnique.Count > 0 Then
ReDim uList(1 To cUnique.Count)
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
CriaListaUser = uList
If Not HorizontalList Then
CriaListaUser = _
Application.WorksheetFunction.Transpose(CriaListaUser)
End If
End If
On Error GoTo 0
End Function
MARCELO.TREZE 02/06/2011 18:05:12
#375718
é isso ta ficando meio enrolado, mas vou tentar explicar uma idéia, seria esta:

faça um for next, em uma coluna onde serão sempre acrecentadas as iniciais.

para ficar algo dinamico, faça este for lendo linha a linha até encontrar uma celula em branco, e parar.

neste mesmo for monte uma string e pronto

exemplo

Dim Iniciais As String
For f=1 to 10000 'irá contar mil linhas se houver
If Celula(f,1) <> [Ô][Ô] then
Iniciais = Iniciais & conteudo da celula celecionada
else
Exit For
End if
Next f

For I = 1 to Len(Iniciais) Step 2
If Application.ActiveCell = Mid(Iniciais,I,2) Or Application.ActiveCell = [Ô][Ô] Then
[ô] faz o que vc deseja
Else
Selection.Delete Shift:=xlToLeft [ô][ô][ô][ô][ô][ô][ô]
End If

acima não lembro como se pega a cellula especifica então coloquei celula, espero que entenda

na teoria o codigo acima montara a string iniciais assim

Iniciais = [Ô]ALBECLDADEEDFRLELUMAMOCAMLFTMFJARBJPAJTMSELFDLCCSOCJ[Ô]

se for adicionado mais uma linha exemplo BP[Ô]
a string ser'[a alterada para isto

Iniciais = [Ô]ALBECLDADEEDFRLELUMAMOCAMLFTMFJARBJPAJTMSELFDLCCSOCJ[txt-color=#e80000]BP[/txt-color][Ô]



espero que vc tenha entendido minha lógica
Tópico encerrado , respostas não são mais permitidas
Voltar