Notifications
Clear all

VBA.Strings.Filter() - Filtra matriz unidimensional

11 Posts
2 Usuários
0 Reactions
1,864 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

No VBE, cliquem em "Exibir", "Janela 'Variáveis locais'"
pq? pq vai ficar fácil pra ver o conteúdo destas matrizes, sem ter que usar a inspeção de variáveis.

p.s.: A janela de visualização de variáveis locais somente exibe as variáveis locais ou passadas como parâmetros, pis estas se tornam locais.
Para visualizar a matriz se ela for global, tem que usar o 'Inspeção de Variáveis' e inserir as variáveis que se quer rastrear ali.

Olha só que legal isso, essa função do VBA.Strings.Filter() que pode ser usada suprimindo-se o Strings e o VBA, conforme modelo abaixo.
Atenção aos parâmetros:
Matriz a ser filtrada, critério de filtragem, incluir (itens com esse critério), tipo de comparação.

Public Sub Filttrar()
Dim Meses       As Variant
Dim Filtrada    As Variant

    Meses = Array("Jan", "Fev", "Mar", "Abr", "Mai", "Jun", "Jul", "Ago", "Set", "Out", "Nov", "Dez")

    Filtrada = VBA.Strings.Filter(Meses, "e", True, vbTextCompare)
    Filtrada = VBA.Strings.Filter(Meses, "e", False, vbTextCompare)
    Filtrada = VBA.Filter(Meses, "e", False, vbTextCompare)
    Filtrada = Filter(Meses, "o", True, vbTextCompare)
    
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/04/2015 9:37 am
(@edcronos)
Posts: 1006
Noble Member
 

não entendi oq essa macro faz

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 10:23 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Ela filtra uma matriz unidimencional, criando outra matriz com o critério definido.
Faça o que eu sugeri, leia o texto, abra a janela de variáveis locais, assim vc vai rodar passo a passo e ver o que acontece com a matriz filtrada. Não é difícil Ed, vai no F8... E veja o q tem dentro da matriz.

Se vc preferir usar janela de inspeção de variáveis, pode tb.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/04/2015 10:58 am
(@edcronos)
Posts: 1006
Noble Member
 

Se vc preferir usar janela de inspeção de variáveis, pode tb.

nunca usei isso, nem sei como usar
não passei pelo basico,
cara para falar a verdade não sei nem como proteger uma planilha corretamente :oops: ,
bem talvez pq nunca tive necessidade

vou testar aqui

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 11:09 am
(@edcronos)
Posts: 1006
Noble Member
 

pelo que entendi ele procura em cada valor da matriz se tem OU não tem o item expecificado e cria uma matriz apenas com esses valores

VBA.Strings.Filter(Meses, "e", True, vbTextCompare)
true cria a nova matriz apenas com os valores que tem "e"
com false apenas com os valores que não tem o item

muito maneiro
mais maneiro ainda pq aprendi a usar a Janela de 'Variáveis locais :D
agora vai ser mais facil ver as mudanças das minhas macros

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 11:32 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

E tb será mais fácil vc migrar aos poucos das globais para as locais ! ;-)

BINGOOOOOOO

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/04/2015 11:49 am
(@edcronos)
Posts: 1006
Noble Member
 

parece que é para matrizes unidimensional
eu uso mais bidimensional

estou partido para a criação de uma macro para trabalhar com array multidimensional para comparação de valores , buscas e modificações sintéticas
essa função funciona para algo assim?

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 11:55 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

eu vi em diversos dos seus códigos que vc usa bastante matrizes (ou vetores) unidimensionais Ed...

Não vem que não tem kkkk !

Ok, concordo que as matrizes na maioria das vezes são bidimensionais, pq estamos no Excel... E tiramos elas direto das células... mas há muitos casos em q elas são unidimensionais...

infelizmente ela só funciona com unidimensionais... Ah e digo mais, eu mandei naquele topico do modelo do projeto, uma filterarray que faz algo parecido com bidimensional...

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/04/2015 12:13 pm
(@edcronos)
Posts: 1006
Noble Member
 

as unidimensionais não mexo com realocação de valores, mas mesmo assim é um ponto para futuras utilizações

bem fernando vamos lá

como falei eu uso pq funcionou para mim
deixaria de usar caso encontrasse alternativa sem que leve para uma complicação de minhas macros ?
sim

olha as variaveis publicas que uso
SetorL é a macro que é chamada pelas outras macros para definir as variaveis de posição dos setores

'Locais ou Setores
Public Const Plan_Fixa = "Fixa"
Global Const TabelaSetores = "A10:P32"
Public Const AbAux = "AUXIa"

Public ColunO() As Variant
Public ColunD() As Variant

Public Not_Setor As Long    '-----------retorna que setor não existe
Public Naba As String           '-----------indica Nome daba origem

Public frL(1 To 15) As Byte    '-----Valores auterados a cada execução
Public frC(1 To 15) As Byte    '---Valores auterados a cada execução
Public frLs(1 To 15) As Byte    '-----Valores auterados a cada execução
Public frCd(1 To 15) As Byte    '---Valores auterados a cada execução

Public Rang As String     'range de setor Total
Public RangT As String     'range de setor Total
Public RangD As String     'range de setor Dados

Public Ti As String     'Coluna titulo
Public Cd As String  'Coluna Data
Public iC As String
Public Ci As String     'Coluna inicial
Public Cf As String     'Coluna final
Public Fc As String      'colunas suplementares (Formulas e afins)
Public Ff As String
Public Li As Long   'linha inicial
Public Lf As Long   'Linha final

Public nST As String  'indica Nome do  Setor
Public nSTo As String  'indica Nome do  Setor de ORIGEM
Public Cq As Long   'indica quantidade de colunas do setor
Public CqT As Long   'indica quantidade Total de colunas do setor

Public CqO As Long   'indica quantidade de colunas do setor de ORIGEM
Public CqD As Long   'indica quantidade de colunas do setor de Destino
Public nP As String    'informa de qual plan se origina os dados
Public nPo As String    'informa de qual plan se origina o setor
Public nPi As String    'informa de qual plan se origina a Aba
Public Ord As Byte    'informa ordem na planilha
Public Cor1 As Long
Public Cor2 As Long
Public CorSt(1 To 3, 1 To 2) As Long
'------------------------------------------( Macros Pincipais  )--------------------






Sub SetorL(ByVal Setor_Nome_ou_Numero As Variant, Optional ByVal Nome_aba As String)    ', Optional Nome_pasta_trabalho As String)
    Dim arr() As Variant

    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name        'Planilha Ativa
    Sheets(Nome_aba).Range(TabelaSetores).Calculate
    arr = Sheets(Nome_aba).Range(TabelaSetores).Value2

    If Setor_Nome_ou_Numero > 0 And Setor_Nome_ou_Numero < 16 Then
        k = Setor_Nome_ou_Numero
    Else

        For k = 1 To UBound(arr, 2)    '15
            If arr(3, k) = Setor_Nome_ou_Numero Then GoTo setx    'Exit For
        Next
        GoTo fim
    End If
setx:
    Ti = arr(5, k)    '.Cells(14, K).Value2'------------------------------coluna de titulos ou index ( Primeira Coluna Do Setor )
    Cd = arr(6, k)    '.Cells(15, K).Value2' -------------------------coluna de datas
    iC = arr(7, k)    ' .Cells(16, K).Value2'---------------------ultima coluna fixa do setor
    Ci = arr(8, k)    '.Cells(17, K).Value2'----------------Coluna inicial dados
    Cf = arr(9, k)    '.Cells(18, K).Value2'------------Coluna final dados
    Fc = arr(10, k)    '.Cells(19, K).Value2'------Coluna de função do setor "Fixa"
    Li = arr(1, 5)  '.Cells(22, K).Value2
    Lf = arr(1, 6)  '.Cells(23, K).Value2
    '----------------------------------------------------------------------------------------------------------------------------------------
    nPi = arr(1, 3)    '.Cells(10, 2).Value2    '-------------------------------Nome da Aba de origem dos dados
    nP = arr(1, 2)    '.Cells(10, 2).Value2    '---------------------------Nome da Aba atual
    nST = arr(3, k)    '.Cells(12, K).Value2       '------------------indica Nome do  Setor
    Ord = arr(4, k)    '.Cells(13, K).Value2'----------------indica porssicao na planilha
    '----------------------------------------------------------------------------------------------------------------------------------------
    Cq = arr(11, k)    '.Cells(20, K).Value2   '------------quantidade colunas de dados moveis do setor
    CqT = Cq + 3    '---------------------------------------quatidade total de colunas do setor
    '----------------------------------------------------------------------------------------------------------------------------------------
    Cor1 = arr(17, k)    '.Cells(26, K).Value2 'Cores do Setor
    Cor2 = arr(18, k)    '.Cells(27, K).Value2

    '----------------------------------------------------------------------------------------------------------------------------------------
    Not_Setor = 0
    Exit Sub
fim:
    Not_Setor = 1
    MsgBox "Setor " & Setor_Nome_ou_Numero & " não existe em " & Nome_aba

End Sub


'************************ Ajusta quantidade de Colunas ***********************************************
Sub ColunasN(ByVal Quantidade_de_Colunas As Long, Optional Nome_aba As String)   '(ByVal Nome_SETOR As String,
    If Limit = 1 Then MsgBox "Execução Proibida": Exit Sub
    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    Dim Ma As Long, N As Long
    Ma = Quantidade_de_Colunas

    With Sheets(Nome_aba)

        .Range(TabelaSetores).Calculate
        If Limit(1) <> "AUXIa" Then Desformata
        If Ma > 2 Then
            Cf1 = Let_Num_Col(Cf)    'Range(Cf & "1").Column
            If Cq < Ma Then    '--------------------------------------------------------------------------( insere colunas )--------
                N = Ma - Cq
                .Range(.Cells(6, Cf1 + 1), .Cells(1, Cf1 + N)).EntireColumn.Insert
                .Range(.Cells(6, Cf1 - 1), .Cells(12, Cf1)).AutoFill Destination:=.Range(.Cells(6, Cf1 - 1), .Cells(12, Cf1 + N)), Type:=xlFillDefault  ' Espande Formulas
                Cf = Letra_Col(Cf1 + N): Fc = Letra_Col(Cf1 + N + 1)
            End If
            If Cq > Ma Then  ' ------------------------------------------------------------------------( deleta colunas )--------
                N = Cq - Ma - 1
                .Range(.Cells(6, Cf1 - N), .Cells(1, Cf1)).EntireColumn.Delete
                Cf = Letra_Col(Cf1 - (N + 1)): Fc = Letra_Col(Cf1 - N)
            End If
            Cq = Ma
        End If
        .Range(TabelaSetores).Calculate
        If Limit(1) <> "AUXIa" Then Reformata
    End With
End Sub


algumas macros simples que trocam e copiam setores de uma para outro
estão meio bagunçado pq fiz algumas mudanças para adicionar novas funcionalidades como trocar as cores dos setores , ainda não está como eu quero

Sub Reseta(ByVal SetorX As Variant)
    Call SetorL(SetorX)
    If PlanExiste(nPi) <> 1 Then nPi = Plan_Fixa
    Call Copia_SetorO(SetorX, nPi)
    CorSt(1, 1) = Cor1
    CorSt(1, 2) = Cor2
    Call Colar_Setor(SetorX, ColunO)
    Cells(26, Ord).Value2 = CorSt(1, 1)
    Cells(27, Ord).Value2 = CorSt(1, 2)
    formatacor
End Sub

Sub Espelhamento(ByVal numeroSetor As Byte)
    Call Copia_SetorO(numeroSetor)
    Call Espelhar(ColunO, 1)
    Call Colar_Setor(numeroSetor, ColunO)
End Sub

Sub TrocarTeste()
    If Limit = 1 Then Exit Sub
    Inicio
    Call Troca_Setor(2, 5, 1)
    Final
End Sub


'-----------( Troca os dados de um Setor com os Dados de Outro Setor )---*
Sub Troca_Setor(ByVal SetorX1 As Variant, ByVal SetorX2 As Variant, Optional ByVal Cor_fotr As Long)
    If Limit = 1 Then Exit Sub
    Inicio
    Call Copia_SetorO(SetorX1)
    nomest1 = Cells(1, Ci).Value2
    Call Copia_SetorD(SetorX2)
    nomest2 = Cells(1, Ci).Value2


    Call Colar_Setor(SetorX2, ColunO)
    Cells(1, Ci).Value2 = nomest1
    Range(TabelaSetores).Calculate
    If Cor_fotr = 1 Then
        Cells(26, Ord).Value2 = CorSt(1, 1)
        Cells(27, Ord).Value2 = CorSt(1, 2)
        formatacor
    End If
    Call Colar_Setor(SetorX1, ColunD)
    Cells(1, Ci).Value2 = nomest2
    Range(TabelaSetores).Calculate
    If Cor_fotr = 1 Then
        Cells(26, Ord).Value2 = CorSt(2, 1)
        Cells(27, Ord).Value2 = CorSt(2, 2)

        formatacor
    End If



    Final
End Sub

'-----------( Copia os dados de um SetorOrigem "pode ser de outra planilha" em um SetorDestino na planilha ativa )---****
Sub Copia_SetorO(ByVal SetorOrigem As Variant, Optional ByVal Nome_aba As String)
    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    Call SetorL(SetorOrigem, Nome_aba)
    Rang = Ti & Li & ":" & Fc & Lf    'Range total do setor
    ColunO = Sheets(Nome_aba).Range(Rang).Value2
    CqO = Cq
    CorSt(1, 1) = Cor1
    CorSt(1, 2) = Cor2
End Sub

Sub Copia_SetorD(ByVal SetorOrigem As Variant, Optional ByVal Nome_aba As String)
    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    Call SetorL(SetorOrigem, Nome_aba)
    Rang = Ti & Li & ":" & Fc & Lf   'Range total do setor
    ColunD = Sheets(Nome_aba).Range(Rang).Value2
    CqD = Cq
    CorSt(2, 1) = Cor1
    CorSt(2, 2) = Cor2
End Sub

Sub Colar_Setor(ByVal SetorDestino As Variant, ByRef NomeArray As Variant, _
        Optional ByVal linha_inicial As Long, Optional ByVal Nome_aba As String)

    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    If Limit = 1 Then MsgBox "Execução Proibida": Exit Sub

    Dim Qc As Long
    Qc = UBound(NomeArray, 2) - 4
    Call SetorL(SetorDestino, Nome_aba)
    If Cq <> Qc Then
        Call ColunasN(Qc, Nome_aba)
    End If

    'Lf = ULinhaRange(Ti, Fc)
    Sheets(Nome_aba).Range(Ti & Li, Fc & Lf).ClearContents
    If linha_inicial > 0 Then Li = linha_inicial
    Lf = Li + UBound(NomeArray, 1) - 1
    Sheets(Nome_aba).Range(Ti & Li, Fc & Lf).Value2 = NomeArray


End Sub

são apenas algumas, eu penso em melhorar e muito as macros
mas ainda preciso definir uma estrutura definitiva para a planilha

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 12:27 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

saber aonde vc precisa chegar, é fundamental pra saber como fazer da melhor maneira...

Então, há como filtrar matriz unidimensional, com código pronto do VBA, o assunto deste tópico. E há como filtrar matriz bidimensional, com o código que mandei ha meses, que chama FilterArray.

As vezes *(e espero que um dia vc encontre a necessidade) isso é mais útil e rápido do que filtrar pela planilha.

;-)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/04/2015 1:12 pm
(@edcronos)
Posts: 1006
Noble Member
 

ainda não uso filtragens em minha planilha, a minha base de dados é limitada

no momento eu apenas faço deslocamentos e realocações dos dados para comparar e fazer cruzamento de dados
até ordenar(alguns tipos) é por array

mas nunca é demais aprender algo novo
o objetivo principal da planilha já foi pro brejo a muito tempo

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 10/04/2015 2:10 pm