Notifications
Clear all

Matriz, VBA - Laços - Dúvidas

10 Posts
2 Usuários
0 Reactions
1,765 Visualizações
(@fpaulajr)
Posts: 4
Active Member
Topic starter
 

Preciso criar um laço de 3 níveis, para copiar colunas selecionadas de uma planilha de uma pasta de trabalho - aberta ou fechada - para uma planilha de outra pasta de trabalho.

---
Exemplo de laço em três níveis:

Dim c As Integer, i As Integer, j As Integer

For c = 1 To 3
For i = 1 To 6
For j = 1 To 2
Worksheets(c).Cells(i,j).Value = 100
Next j
Next i
Next c
---

Seria isso que devo fazer:

Crio a matriz com os numeros das colunas que quero

Dim ColunasSolicitadas() as integer = (2,3,4,5,8,11,13,21)

Const NumRows& = 50 (número de linhas que quero)
Const NumColumns$ = 8 (número de colunas que quero)

' Coluna 2 - Nome do Funcionario
' Coluna 3 - Situação do Funcionario
' Coluna 4 - Cargo do Contrato
' Coluna 5 - ....

-------

For Row = 1 To NumRows
For Column = 2 To NumColumns
Assumo as Colunas que quero
ColunasSolicitadas(NumColumns) = NumColums - 2 - Isso não funciona e não sei se aqui é o local correto para isso.
Address = Cells(Row, ColunasSolicitadas).Address
Cells(Row, ColunasSolicitadas) = GetData(FilePaht, FileName, SheetName, Address)
Columns.AutoFit
Next ColunasSolicitadas
Next Column
Next Row

ActiveWindow.DisplayZeros = False

--------

ColunasSolicitadas(NumColumns) = NumColums - 2 *** (será um ponteiro que irá percorrer as colunas)

Como ColunasSolicitadas é uma matriz, o ponteiro inicia do zero
Como NumColumns começa no 2 e vai até 8, que é o número de colunas que quero

ColunasSolicitadas 2,3,4,5,8,11,13,21
O ponteiro ColunasSolicitadas(NumColums) irá percorrer as colunas 0,1,2,3,4,5,6,7,8

Não consigo criar um ponteiro dessa forma pois aparentemente o VBA não trabalha assim com passagens de parâmetros. Teria que usar lbound, ubound.

ColunasSolicitadas(NumColumns) = NumColums - 2
Address = Cells(Row, ColunasSolicitadas).Address
Cells(Row, ColunasSolicitadas) = GetData(FilePaht, FileName, SheetName, Address)

/Fernando

 
Postado : 26/02/2014 6:14 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Fernando, não entendi corretamente o que deseja, porem veja se assim está +/- em linha
Obs.: Evite/não utilize nomes de variaveis que se confundem/conflitem com nomes internos. Por Exemplo:= Row, Column....

Sub laco()
Dim c As Integer, i As Integer, j As Integer

For c = 1 To 3
For i = 1 To 6
For j = 1 To 2
Worksheets(c).Cells(i, j).Value = 100
Next j
Next i
Next c
'---
'Seria isso que devo fazer:
'Crio a matriz com os numeros das colunas que quero
Dim ColunasSolicitadas(1 To 8) As Integer
ColunasSolicitadas(1) = 2
ColunasSolicitadas(2) = 3
ColunasSolicitadas(3) = 4
ColunasSolicitadas(4) = 5
ColunasSolicitadas(5) = 8
ColunasSolicitadas(6) = 11
ColunasSolicitadas(7) = 13
ColunasSolicitadas(8) = 21

Const NumRows& = 50 '(número de linhas que quero)

For Linha = 1 To NumRows
    For Col = LBound(ColunasSolicitadas) To UBound(ColunasSolicitadas)
        'Assumo as Colunas que quero
        'ColunasSolicitadas(NumColumns) = NumColums - 2 - Isso não funciona e não sei se aqui é o local correto para isso.
        MsgBox ColunasSolicitadas(Col)
    Next
Next

ActiveWindow.DisplayZeros = False

End Sub
 
Postado : 26/02/2014 7:04 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Conforme me informou em mensagem privada, o objetivo é utilizar a função GetValue (você passou o endereço mas esqueci), porem similar ao disposto no site do colega Felipe Gualberto (Bezadeus) http://www.ambienteoffice.com.br/Excel/obter_dados_de_pastas_de_trabalho_fechadas/.
No arquivo anexo está presente as duas funções (do site que indicou e do ambiente office)
Na Plan1 coluna F são informado as variáveis de local/arquivo e planilha. Na Plan2 são "gravados" os dados.
Veja se lhe auxilia.

 
Postado : 26/02/2014 4:36 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Reinaldo, função semelhante ao do modelo do ambientoffice, podemos encontrar no link abaixo, não sei se foi este o endereço que o Fernando indicou, eles têm outros modelos bem interessantes.
http://www.interactiveds.com.au/software.html

Mas voltando a questão, o Fernando havia postado tambem no forum do Tomas e como a resposta primeira foi aqui, então continuamos daqui, e conforme eu passei a ele, se chegarmos a uma solução plausivel eu coloco la.
Pelo que entendi, conforme explicação dele no forum do Tomas, eu acredito que o ideal é a conexão ADO, uma vez que como ele mesmo disse tambem este recurso le celula por celula o que irá demandar muito tempo de programação pela qde de dados que disse ter no BD, mas ele diz que o incoveniente é usar ADO é ter de deixar o BD aberto, e como eu disse, se ele usou o Modelo de Cadastro do Tomas, o BD é aberto, mas fica com a condição de oculto uma vez que são feitas alterações atraves do formuláro de Cadastro, mas como é somente para buscar dados não necessitaria estar aberto, não tenho certeza, pois não utilizo muito este recurso, fiquei de pesquisar e dar uma posição, mas, se você tiver alguma experiência com ADO poderá confirmar se é isto mesmo.

Quanto ao modelo que colocou, fiz alguns testes e vi que as rotinas puxam os dados das colunas 1 até a 8, acredito que nas adaptações que fez acabou pássando despercebido, ou seja, se a intensão é puxar os dados somente das colunas que estão no Vetor, temos de ajustar as linhas :

Na rotina :
Sub Laco()
Trocar esta:
sEnd = Cells(Linha, Col).Address por esta : sEnd = Cells(Linha, (ColunasSolicitadas(Col))).Address.

e na :
'Executar esta rotina para testar a função ObterDadosExternos
Sub Teste()
Trocar esta:
sEnd = Cells(Linha, Col).Address por esta : sEnd = Cells(Linha, (ColunasSolicitadas(Col))).Address.

e esta:
Sheets("Plan2").Cells(Linha, Col) = GetValue(sPath, sPasta, sPlan, sEnd), por esta :
Sheets("Plan2").Cells(Linha, Col) = ObterDadoExterno(sPath, sPasta, sPlan, sEnd)

Como estamos falando de Array, e adaptando suas rotinas, poderiamos fazer da seguinte forma:

Sub LacoArray()
Dim sPath As String, sPasta As String, sPlan As String, sEnd As String
Dim nRow As Integer

Dim ColunasSolicitadas As Variant
Dim Col

'Carregando as informações de caminho e arquivo
sPath = Sheets("Plan1").Range("F1") 'ThisWorkbook.path
sPasta = Sheets("Plan1").Range("F2") '"banco.xlsx"
sPlan = Sheets("Plan1").Range("F3") '"Plan1"

'Informa o numero de linhas
nRow = 10

'Carregando Array de colunas
ColunasSolicitadas = Array(2, 3, 4, 5, 8, 11, 13, 21)

      For Linha = 2 To nRow
            For Each Col In ColunasSolicitadas
                  sEnd = Cells(Linha, Col).Address
                  Sheets("Plan2").Cells(Linha, Col) = GetValue(sPath, sPasta, sPlan, sEnd)
                  Columns(Col).AutoFit
            Next Col
      Next Linha

End Sub

Ou :

'Executar esta rotina para testar a função ObterDadosExternos
Sub TesteArray()
Dim sPath As String, sPasta As String, sPlan As String, sEnd As String
Dim nRow As Integer, Linha As Integer

Dim ColunasSolicitadas As Variant
Dim Col

    'Carregando as informações de caminho e arquivo
    sPath = Sheets("Plan1").Range("F1") 'ThisWorkbook.path
    sPasta = Sheets("Plan1").Range("F2") '"banco.xlsx"
    sPlan = Sheets("Plan1").Range("F3") '"Plan1"

'Carregando Array de colunas
ColunasSolicitadas = Array(2, 3, 4, 5, 8, 11, 13, 21)

'Informa o numero de linhas
nRow = 10
'Imprime valor do endereço acima da janela de Verificação imediata:
'Debug.Print ObterDadoExterno(sPath, sPasta, sPlan, sEnd)
      For Linha = 2 To nRow
            
            For Each Col In ColunasSolicitadas
                  sEnd = Cells(Linha, Col).Address
                  Sheets("Plan2").Cells(Linha, Col) = ObterDadoExterno(sPath, sPasta, sPlan, sEnd)
                  Columns(Col).AutoFit
            Next Col
            
      Next Linha
      
End Sub

As adaptações é mais para ilustrar a utilização das possiveis variações com Arrays, uma vez que temos os mesmoos resultados e efeitos, só necessitaria testar cada uma com o BD maior para ver se ha variações no tempo de processamento, se pesquisarmos na Net encontramos uma infinidade de exemplos sobre o assunto.

De qualquer forma, é aguardarmos uma posição do Fernando.

[]s

 
Postado : 26/02/2014 9:41 pm
(@fpaulajr)
Posts: 4
Active Member
Topic starter
 

Bom Dia

Prezados amigos de programação - em especial Mauro Coutinho e Reinaldo.

Procurarei esclarecer alguns pontos:

a) a macro que utilizo é de John Walkenbach (Mr. Spreadsheet) em http://j-walk.com/ss/excel/tips/tip82.htm - mas o site foi atualizado e agora a função getdata() não aparece mais - tem um exemplo agora com getvalue() - gostei do código pois ele é claro, limpo e otimizado;

b) os modelos que vocês comentaram - se for o mesmo do cadastro da Onofre, eu baixei mas não consegui acessar - problemas com o usuário e senha;

c) as conexões que faço com planilhas ou banco de dados - utilizo o MSQRY32 (2003 ou 2007) ou a conexão de dados dentro do excel 2007, não me preocupando com os métodos de conexão na programação;

d) na verdade nunca me preocupei com o uso de VBA pois entendo que, principalmente, no órgão público é dificil a questão da documentação do que é feito e da mão de obra que possa dar continuidade ao projeto - utilizo muito mais as funções, com recursividade e tudo;

e) no momento quero quebrar um paradigma em duas frentes - uma possibilitar a criação de um business intelligence (BI) utilizando uma planilha já existente com os dados de RH e num segundo momento, utilizar um banco de dados free (órgão público) MySQL e através do Excel realizar as consultas e o BI;

f) minha maior dificuldade é com a programação OO, não me entendo com as classes de objeto mas chego lá;

g) com as dicas de vocês percebi como funciona a getdata(), e ao fazer um teste com a massa de dados atual - 2850 linhas e 17 colunas = 48.450 células - muita coisa e a conexão de dados com a planilha - não sei se estou fazendo da maneira correta - tem a incoveniencia de avisar que a planilha está sendo utilizada - está em modo de leitura, etc. isso é ruim.

Percebo que, no código enviado, a solução seria a substituição da função getdata() por uma que leia a planilha toda mas, isso não é necessário, das 17 colunas precisarei apenas de 8 colunas.

Abaixo o código que estou trabalhando. caso necessário envio a planilha.

-----
Option Explicit

'credit for this technique goes to John Walkenback
'http://j-walk.com/ss/excel/tips/tip82.htm

Sub GetDataDemo()

Dim FilePath$, Row&, Column&, Address$

'change constants & FilePath below to suit
'************************************
Const FileName$ = "RH SECRETARIA DE SAUDE.xls"
Const SheetName$ = "Ativos"
Const NumRows& = 2850
Const NumColumns& = 8
FilePath = ActiveWorkbook.Path & ""
'
************************************

DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 2 To NumColumns
Address = Cells(Row, Column).Address
Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

-----

Agradeço o empenho e dedicação de vocês.

/Fernando

 
Postado : 27/02/2014 5:40 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bem não sou versado em conexões Ado, porem sei que é possível utilizar essa conexão e obter dados de planilhas fechadas e abertas, porem nessa ultima somente os dados já salvos, e que serão "visiveis".
Um bom exemplo é no site do Ron De Bruin ( http://www.rondebruin.nl/win/s3/win024.htm ) e planilha modelo anexa. Nesse modelo é possível obter uma range definida (melhor do que celula a celula).
Outro modelo, foi (iniciado por uma usuária aqui do fórum mesmo - Val, mas que está ausente a muito tempo), faz a comparação dos dados em uma planilha do BD e traz seu relativo de outra planilha.

 
Postado : 27/02/2014 8:27 am
(@fpaulajr)
Posts: 4
Active Member
Topic starter
 

Boa Tarde

Prezados excelistas e amigos Mauro e Reinaldo

Minha versão - rascunho - final está abaixo. Funciona mas, como a base de dados é grande, há um tempo de processamento muito grande. Com certeza farei uma conexão via msqry32 ou conexão de dados dentro do excel 2007. Não lido muito bem com a questão do código ADO, ainda. Auxilio serão bem vindos.

Uma coisa que me incomoda é a solução que fiz para apagar as colunas da planilha destino Sub DelCols(), que não desejo. A função GetData trabalha, como já visto, célula a célula. Ideias e sugestões são bem vindas. agradeço.

-----

Versão Final

-----

Option Explicit

'credit for this technique goes to John Walkenback
'http://j-walk.com/ss/excel/tips/tip82.htm

Sub GetDataDemo()

Dim FilePath$, Row&, Column&, Address$
Dim ColumnInt As Integer
Dim Linha As Integer
Dim Col As Variant
Dim ColunasSolicitadas As Variant
ColunasSolicitadas = Array(2, 3, 4, 5, 8, 9, 10, 11, 12, 13, 24, 25, 27)

'Nome Situacao Cargo Escolaridade Contratante Regime Concurso Diretoria Distrito Horario Carga Horaria

'change constants & FilePath below to suit
'************************************
Const FileName$ = "RH SECRETARIA DE SAUDE.xls"
Const SheetName$ = "Ativos"
Const NumRows& = 10
Const NumColumns& = 13
FilePath = ActiveWorkbook.Path & ""
'
************************************

DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Linha = 1 To NumRows
For Each Col In ColunasSolicitadas
Address = Cells(Linha, Col).Address
Cells(Linha, Col) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Col
Next Linha
ActiveWindow.DisplayZeros = False
DelCols
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

Sub DelCols()
Range("Z1,W1,V1,T1,S1,R1,Q1,P1,O1,N1,G1,F1").EntireColumn.Delete
End Sub

-----

-----

 
Postado : 28/02/2014 10:14 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Para nao ter que deletar colunas utilize outra variável para posicionar o registro na coluna esperada, chamei a variável de xCol e inicia na primeira coluna do Array.

Application.ScreenUpdating = False
    If Dir(FilePath & FileName) = Empty Then
        MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
        Exit Sub
    End If
    For Linha = 1 To NumRows
        xCol = ColunasSolicitadas(0) 'Altere aqui para a coluna que deseja iniciar
            For Each Col In ColunasSolicitadas
                Address = Cells(Linha, Col).Address
                Cells(Linha, xCol) = GetData(FilePath, FileName, SheetName, Address)
                xCol = xCol + 1
                Columns.AutoFit
            Next Col
    Next Linha
 
Postado : 28/02/2014 1:18 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Como sabido, o método GetData, utiliza célula a célula, então vai ficar um tanto quanto lento para o tamanho de sua planilha.

Experimente a rotina abaixo e retorne:

Private Sub ObtemDados()
'Declaração de vairaveis
Dim oConn As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRS As ADODB.Recordset
' abre uma conexao com a planilha excel
Set oConn = New ADODB.Connection

oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                     "Data Source=" & ThisWorkbook.Path & "RH SECRETARIA DE SAUDE.xls;" & _
                     "Extended Properties=""Excel 8.0;HDR=Yes;"";"

' cria o objecto command e define a conexao ativa
Set oCmd = New ADODB.Command
oCmd.ActiveConnection = oConn

' abre a planilha
oCmd.CommandText = "SELECT NOME,SITUAÇÃO,[CARGO CONTRATO],ESCOLARIDADE,CONTRATANTE,[REGIME CONTRATO],CONCURSO,DIRETORIA,[DISTRITO DE SAUDE],[LOTAÇÃO 1],[CARGA HORARIA TOTAL/SEMANAL],SECRETARIA,SEXO  from [ATIVOS$]"

' cria o recordset com os dados
Set oRS = New ADODB.Recordset
oRS.Open oCmd, , adOpenKeyset, adLockOptimistic
'Copia os campos para o cabeçalho
  For n = 0 To oRS.Fields.Count - 1
    Cells(1, n + 2) = oRS.Fields(n).Name
  Next n
'exibe os dados
Cells(2, 2).CopyFromRecordset oRS
Cells.EntireColumn.AutoFit
oRS.Close
oConn.Close
End Sub
 
Postado : 28/02/2014 1:21 pm
(@fpaulajr)
Posts: 4
Active Member
Topic starter
 

Boa Tarde

Reinaldo, a sua sugestão e ideia para a solução foram ao ponto. Deu certo, funciona perfeitamente. Nunca havia utilizado ADODB dessa forma, apenas utilizava a conexão de dados do 2007 (Obter Dados) ou o MSQuery32 que criava as consultas em SQL e depois a utilizava dentro das planilhas. Foi ótimo.

Apenas uma observação - para funcionar corretamente no Exel 2007, que não é o foco do fórum, deve ser adicionada a referência - no VBE:
Microsoft ActiveX Data Objects 2.8 Library

Sem isso, ocorrerá um erro de compilação.

Abraços, muito obrigado.

/Fernando

 
Postado : 06/03/2014 1:25 pm