none
Como atribuir valores de células a uma matriz? RRS feed

  • Pergunta

  • Há alglum tempo não trabalho com VBA e estou com o seguinte código sem funcionar:

    Dim MtxEnt(200, 2) As Double
    MtxEnt(0, 0) = ActiveCell.Value

    Como posso atribuir valores de células a uma matriz?
    domingo, 8 de julho de 2012 20:06

Respostas

  • Com essa declaração, MtxEnt é uma matriz bidimensional de índices (0 a 200) e (0 a 2), considerando que você utiliza a declaração Option Base 0 (que é o padrão).

    Pessoalmente, prefiro deixar bem claro as declarações de variáveis. No seu caso, eu faria:

    Sub Exemplo()
        Dim MtxEnt(0 To 200, 0 To 2) As Double
    End Sub

    Você obteve erro porque declarou essa matriz como Double, isto é, ela aceita apenas valores numéricos. Se a célula ativa estiver com um texto no momento em que você executa essa macro, você obtém um erro.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta marlon2s sábado, 4 de agosto de 2012 21:50
    segunda-feira, 9 de julho de 2012 21:40
    Moderador

Todas as Respostas

  • Funcionou quando usei "Dim MtxEnt(200,2)" sem nenhum tipo.
    domingo, 8 de julho de 2012 20:11
  • Com essa declaração, MtxEnt é uma matriz bidimensional de índices (0 a 200) e (0 a 2), considerando que você utiliza a declaração Option Base 0 (que é o padrão).

    Pessoalmente, prefiro deixar bem claro as declarações de variáveis. No seu caso, eu faria:

    Sub Exemplo()
        Dim MtxEnt(0 To 200, 0 To 2) As Double
    End Sub

    Você obteve erro porque declarou essa matriz como Double, isto é, ela aceita apenas valores numéricos. Se a célula ativa estiver com um texto no momento em que você executa essa macro, você obtém um erro.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta marlon2s sábado, 4 de agosto de 2012 21:50
    segunda-feira, 9 de julho de 2012 21:40
    Moderador
  •    Acho que isso aconteceu porque em algumas células possuo "números" com vírgula, quando o VBA aceita números com pontos, penso eu.

       No caso, colei a matriz em uma planilha e, em seguida, dei um jeito de "converter" os valores em numéricos, com bastante trabalho.

    sábado, 4 de agosto de 2012 21:50
  • Você disse que colou as células como números com bastante trabalho, mas existem formas mais simples. Como fez isso?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 6 de agosto de 2012 10:13
    Moderador
  • Queria mesmo saber formas mais simples. Bem, lá vai:

    Alguns números infelizmente estão isolados por colchetes (usa-se assim na tabela por norma, para saber que são valore médios), hífens, etc. Daí, além de converter em números, preciso retirar esse tipo de coisa.

    O programa varre planilhas e procura uns dados; em seguida esses dados são jogados em uma planilha em particular de modo a montar uma tabela.

    A solução foi então construir uma nova tabela (colunas C e D), com os valores da primeira "corrigidos" (colunas A e B):

    A função abaixo quebra os números contendo hífen (exemplo: 10-20 é quebrado em myarray(0) = 10 e myarray(1) = 20). Para cada palavra (10 e 20), o programa verifica se ela é mesmo um número (função getnum).


    LastRowOldTable: guarda a última linha da primeira tabela.

    title: nome da propriedade cujo valor é expresso pelo número à frente.


    Sendo número, então ele é armazenado na nova tabela (colunas C e D).



        For linha = 1 To LastRowOldTable 'para cada registro (linha)
            MyArray = Split(Replace(Sheets(Sheets.Count).Range("b" & linha).Value, "-", " - "), " ") 
            title = Sheets(Sheets.Count).Range("A" & linha).Value
            For palavra = LBound(MyArray) To UBound(MyArray)
                If GetNum(MyArray(palavra)) <> "" Then
                     Sheets(Sheets.Count).Range("C" & LastRowNewTable) = title
                     Sheets(Sheets.Count).Range("D" & LastRowNewTable) = Val(GetNum(MyArray(palavra)))
                     LastRowNewTable = LastRowNewTable + 1
                End If
            Next palavra
        Next linha



    Função GetNum:


    Function GetNum(Phrase As String) As String 'RETIRA COLCHETES, HÍFENS, ETC
    
    '   CHAMADA PARA TRATAMENTO DE ERRO
        On Error GoTo EndFunc
    
    '   DECLARAÇÕES
        Dim Temp As String
        Dim caractere As Long
    
    
    '   OBTÉM OS NÚMEROS
        Temp = ""
        If InStr(1, Phrase, "º") Or InStr(1, Phrase, "(") Or InStr(1, Phrase, ")") Then GoTo EndFunc  'se houver o símbolo de graus, então nada é retornado
        
            For caractere = 1 To Len(Phrase) 'para cada caractere da palavra, se ele for numérico
                If (IsNumeric(Mid(Phrase, caractere, 1))) = True Or Mid(Phrase, caractere, 1) = "," Then _
                    Temp = Temp & Mid(Phrase, caractere, 1) 'então é adicionado à variável temporária
            Next caractere
            
            If Len(Temp) = 0 Then 'se, no final da avaliação, não houver nada numérico
                GetNum = "" 'então nada é retornado
            Else 'do contrário, a função retorna os números naquela palavra
                If InStr(1, Temp, ",") Then 'caso haja vírgulas
                    Temp = Replace(Temp, ",", ".") 'precisam ser convertidas em pontos
                    GetNum = Temp
                Else
                    GetNum = Temp
                End If
                
            End If
        Exit Function
            
    EndFunc:
            GetNum = Temp
    End Function
    

    Olhando agora, nem lembro para que serve a função Mid().

    Ignorando essa história de ter de tirar parênteses, colchetes, graus, etc. O código abaixo seria o modo mais simples?!

    Sub teste()
    
    Dim celula As Range
    Dim intervalo As Range
    Dim ultimalinha As Long
    ultimalinha = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    
    Set intervalo = Range("B2:B" & ultimalinha)
    
    For Each celula In intervalo
        celula.Value = Val(celula)
    Next
    
    End Sub


    quarta-feira, 5 de setembro de 2012 21:28
  • Minha sugestão para a função GetNum:

    Function GetNum(sCadeia As String) As Double
        Dim lChar As Long
        Dim sChar As String
        Dim sFiltrado As String
        
        For lChar = 1 To Len(sCadeia)
            sChar = Mid(sCadeia, lChar, 1)
            Select Case sChar
                Case "0" To "9"
                    sFiltrado = sFiltrado & sChar
                Case ".", ","
                    If InStr(sFiltrado, ",") = 0 Then
                        sFiltrado = sFiltrado & ","
                    End If
            End Select
        Next lChar
        
        If Len(sFiltrado) > 0 Then
            GetNum = CDbl(sFiltrado)
        End If
    End Function

    Não tenho como testar, mas experimente escrever algo como mostrado abaixo para a primeira rotina:

        Dim MyArray() As String
        Dim linha As Long
        Dim Title As String
        Dim palavra As String
        Dim LastRowNewTable As Long
        
        With Sheets(Sheets.Count)
            For linha = 1 To LastRowOldTable    'para cada registro (linha)
                MyArray = Split(.Range("B" & linha), "-")
                Title = .Range("A" & linha).Value
                For palavra = LBound(MyArray) To UBound(MyArray)
                    If GetNum(MyArray(palavra)) > 0 Then
                        .Range("C" & LastRowNewTable) = Title
                        .Range("D" & LastRowNewTable) = GetNum(MyArray(palavra))
                        LastRowNewTable = LastRowNewTable + 1
                    End If
                Next palavra
            Next linha
        End With
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 5 de setembro de 2012 23:12
    Moderador
  • Muito obrigado,

    estarei estudando a resposta.

    Por ora, havia feito o seguinte, desconsiderando a questão do hífen:

    Dim celula As Range
    Dim intervalo As Range
    Dim ultimalinha As Long
    ultimalinha = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    Set intervalo = Range("B2:B" & ultimalinha)
    
    '*************************tira colchetes
    For Each celula In intervalo
        If InStr("[", celula) = Null Then
        Else
            celula = Replace(celula, "[", "")
        End If
    Next
    For Each celula In intervalo
        If InStr("]", celula) = Null Then
        Else
            celula = Replace(celula, "]", "")
        End If
    Next
    '*************************tira colchetes
    
    For Each celula In intervalo
        celula = Replace(celula, ".", ",")
        celula.FormulaLocal = celula.Value 'converte em números
    Next
    

    quarta-feira, 5 de setembro de 2012 23:30