Como atribuir valores de células a uma matriz?

Question

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?

Answer 1

Funcionou quando usei "Dim MtxEnt(200,2)" sem nenhum tipo.

Answer 2

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

Answer 3

   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.

Answer 4

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

Answer 5

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

Answer 6

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

Answer 7

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