Fernanda Sanches

Boa tarde, Após muitas tentativas consegui fazer o que eu queria. Vou deixar o código aqui caso alguém um dia precise. Muito obrigada pela ajuda! Em "ThisWorkbook" do arquivo onde está o relatório colar o código abaixo: Ao abrir o arquivo do relatório automaticamente irá abrir o arquivo onde estão os dados. Algumas funções só funcionam com o arquivo de dados aberto. Ao fechar o arquivo do relatório automaticamente irá salvar e fechar o arquivo de dados. Private Sub Workbook_Open()Workbooks.Open ("C:\Users\fernanda.rocha\Desktop\banco de dados.xlsx")Workbooks("relatório").ActivateEnd SubPrivate Sub Workbook_BeforeClose(Cancel As Boolean)Workbooks("banco de dados").Close savechanges:=True 'salvar TrueEnd Sub No formulário criado para a busca dos nomes de clientes colocar o código abaixo no TextBox: Na pesquisa de nomes mesmo desabilitando algumas funções ainda fica meio lento quando você digita um nome diferente do que está no banco de dados. Estou tentando fazer esta parte ficar mais rápida para que essa demora não vire um problema ao fazer relatório. Se vocês tiverem alguma ideia de como fazer isso, por favor, me informem. Option ExplicitPrivate sInput As StringDim lPalavra As StringDim sDado As StringDim flParar As BooleanDim iRow As LongDim sCaminho As StringDim sPastaDeTrabalho As StringDim sPlanilha As StringDim sEndereço As String Function ObterDadoExterno() 'É necessário que o caminho termine com uma \ If Right(sCaminho, 1) <> "\" Then sCaminho = sCaminho & "\" End If sDado = "'" & sCaminho & "[" & sPastaDeTrabalho & "]" & _ sPlanilha & "'!" & ThisWorkbook.Sheets(1).Range(sEndereço).Address(, , xlR1C1) ObterDadoExterno = ExecuteExcel4Macro(sDado) End FunctionFunction ObterDadoExterno2() 'É necessário que o caminho termine com uma \ If Right(sCaminho, 1) <> "\" Then sCaminho = sCaminho & "\" End IfEnd Function'Ao digitar deletar ou backspace o sistema limpa a variável de controle para pesquisar novamentePrivate Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Limpa a variável de controle If (KeyCode = vbKeyBack) Or (KeyCode = vbKeyDelete) Then flParar = True Else flParar = False End If If (KeyCode = 13) Then ActiveCell.Value = UserForm1.TextBox1.Text UserForm1.TextBox1.Value = vbNullString UserForm1.Hide End If End Sub 'Faz a busca das palavrasPrivate Sub TextBox1_change() If flParar Then flParar = False Else sInput = Left(Me.TextBox1, Me.TextBox1.SelStart) lPalavra = GetFirstCloserWord(sInput) If lPalavra & "" <> "" Then flParar = True Me.TextBox1.Text = lPalavra Me.TextBox1.SelStart = Len(sInput) Me.TextBox1.SelLength = 999999 End If End IfEnd Sub'Seleciona a primeira letraPrivate Function GetFirstCloserWord(ByVal Word As String) As String Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False Dim c As Range sCaminho = ThisWorkbook.Path sPastaDeTrabalho = "banco de dados.xlsx" sPlanilha = "banco de dados" sEndereço = "A:A" For Each c In Workbooks("banco de dados.xlsx").Sheets("banco de dados").Range("A:A").CellsIf LCase(c.Value) Like LCase(Word & "*") Then GetFirstCloserWord = c.Value Exit Function End IfNext c Set c = Nothing Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Function No botão "Adicionar Novo" colar o código abaixo: Private Sub CommandButton1_Click()Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = FalseDim iRow As LongDim iRow2 As LongsCaminho = ThisWorkbook.Path sPastaDeTrabalho = "banco de dados.xlsx" sPlanilha = "banco de dados" sEndereço = "A:A" Dim wb As Workbook Set wb = Workbooks("banco de dados") Dim b As Integer b = Application.WorksheetFunction.CountIf(wb.Sheets("banco de dados").Range("A:A"), Me.TextBox1.Value)If b > 0 ThenMsgBox "Cliente já cadastrado!", vbCritical, "Cliente duplicado!"End IfiRow = Workbooks("banco de dados").Sheets("banco de dados").Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 iRow2 = Workbooks("relatório").Sheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 Workbooks("banco de dados").Sheets("banco de dados").Cells(iRow, 1).Value = Me.TextBox1.Value Workbooks("relatório").Sheets("Sheet1").Cells(iRow2, 1).Value = Me.TextBox1.Value 'Clean fields TextBox to insert new datasMe.TextBox1.Value = ""Application.Calculation = xlCalculationAutomaticApplication.ScreenUpdating = TrueApplication.EnableEvents = True End Sub

Bom dia, Muito obrigada pelo retorno de vocês!! Eu já tentei a validação de dados, só que ele não aceita pegar a informação de outro arquivo excel somente do mesmo arquivo, pelo menos eu não consegui... E o que eu preciso é usar como fonte de dados um arquivo excel que está fechado. Pegar dados de um arquivo excel fechado já consegui fazer com o código abaixo 'Executar esta rotina para testar a função ObterDadosExternosSub Teste() Dim sCaminho As String Dim sPastaDeTrabalho As String Dim sPlanilha As String Dim sEndereço As String sCaminho = "C:\Users\fernanda.rocha\Desktop\" sPastaDeTrabalho = "banco de dados.xlsx" sPlanilha = "Plan1" sEndereço = "A:A" 'Imprime valor do endereço acima da janela de Verificação imediata: Debug.Print ObterDadoExterno2(sCaminho, sPastaDeTrabalho, sPlanilha, sEndereço)End Sub Function ObterDadoExterno(sCaminho As String, _ sPastaDeTrabalho As String, _ sPlanilha As String, _ sEndereço As String) Dim sDado As String 'É necessário que o caminho termine com uma \ If Right(sCaminho, 1) <> "\" Then sCaminho = sCaminho & "\" End If sDado = "'" & sCaminho & "[" & sPastaDeTrabalho & "]" & _ sPlanilha & "'!" & ThisWorkbook.Sheets(1).Range(sEndereço).Address(, , xlR1C1) ObterDadoExterno = ExecuteExcel4Macro(sDado)End FunctionFunction ObterDadoExterno2(sCaminho As String, _ sPastaDeTrabalho As String, _ sPlanilha As String, _ sEndereço As String) Dim sDado As String 'É necessário que o caminho termine com uma \ If Right(sCaminho, 1) <> "\" Then sCaminho = sCaminho & "\" End If sDado = "'" & sCaminho & "[" & sPastaDeTrabalho & "]" & _ sPlanilha & "'!" & Range(sEndereço).Address(, , xlR1C1) Debug.Print Evaluate("='" & sCaminho & "[" & sPastaDeTrabalho & "]" & _ sPlanilha & "'!" & sEndereço) Range("A1") = "='" & sCaminho & "[" & sPastaDeTrabalho & "]" & _ sPlanilha & "'!" & sEndereço 'ObterDadoExterno2 = "="End Function Não deixar que a pessoa coloque mais de uma vez o mesmo cliente e se for um novo cliente adicionar no banco de dados de clientes eu consigo com o código abaixo. Tenho 3 problemas: 1. eu não consigo fazer com que o novo nome que foi adicionado na aba com os nomes dos clientes apareça também na aba relatório (ao mesmo tempo). 2. o arquivo com os nomes dos clientes está aberto. Quero adicionar a nova informação com a planilha fechada. 3. o nome dos clientes e o relatório estão em um mesmo arquivo excel e eu preciso que sejam arquivos separados. Dim iRow As LongDim ws As WorksheetSet ws = Worksheets("Sheet2")Count = Application.WorksheetFunction.CountIf(Worksheets("Sheet2").Range("A:A"), Me.TextBox1)If Count > 0 ThenMsgBox "Cliente já cadastrado!", vbCritical, "Cliente duplicado!"ElseiRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1'copy datas to the cellsws.Cells(iRow, 1).Value = Me.TextBox1.ValueEnd IfEnd Sub Autocompletar com fonte de dados eu também já consigo com o código abaixo: 'Digite aqui o intervalo a ser autocompletadoPrivate Const r As String = "A:A"Private sInput As String 'Faz parar a pesquisa dos dados digitadosDim flParar As BooleanFunction RetornaLin(Sht As String, Col As String)Dim UltLinPlan As Long 'Retorna a última linha da PlanilhaUltLinPlan = Sheets(Sht).Range("A:A").End(xlDown).Row 'Retorna a linha na planilhaRetornaLin = Sheets(Sht).Range(Col & UltLinPlan).End(xlUp).Offset(1, 0).Row End Function Sub CopiaLinhas()'Uliliza a função criada para buscar a linha para inserçãoDim Lin As Long 'Busca primeira linha disponível da plan1 na coluna ALin = RetornaLin("Sheet1", "A") 'copia o intervalo A5:Z5 para a linha retornada pela funçãoSheets("Sheet2").Range("A:A").End(xlDown).Row.Copy Sheet1.Range("A" & Lin) End Sub'Ao digitar deletar ou backspace o sistema limpa a variável de controle para pesquisar novamentePrivate Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Limpa a variável de controle If (KeyCode = vbKeyBack) Or (KeyCode = vbKeyDelete) Then flParar = True Else flParar = False End If If (KeyCode = 13) Then ActiveCell.Value = UserForm1.TextBox1.Text UserForm1.TextBox1.Value = vbNullString UserForm1.Hide End If End Sub 'Faz a busca das palavrasPrivate Sub TextBox1_change() Dim lPalavra As String If flParar Then flParar = False Else sInput = Left(Me.TextBox1, Me.TextBox1.SelStart) lPalavra = GetFirstCloserWord(sInput) If lPalavra & "" <> "" Then flParar = True Me.TextBox1.Text = lPalavra Me.TextBox1.SelStart = Len(sInput) Me.TextBox1.SelLength = 999999 End If End IfEnd Sub'Seleciona a primeira letraPrivate Function GetFirstCloserWord(ByVal Word As String) As String Dim c As Range For Each c In Sheet2.Range(r).Cells If LCase(c.Value) Like LCase(Word & "*") Then GetFirstCloserWord = c.Value Exit Function End If Next c Set c = Nothing End Function A minha necessidade é: juntar tudo rs Preciso: Colocar o código de pegar dados de um arquivo excel fechado e colocar como a fonte de dados do Autocompletar Ter um código para adicionar informação de um destino (arquivo excel aberto) para a origem (arquivo excel fechado) - Esse eu ainda não encontrei Adicionar a nova informação no arquivo com o nome dos clientes sem que haja repetição (isso eu já consegui mas quando o nome dos clientes está no mesmo arquivo que o relatório, e eu preciso que seja em arquivos separados e com o arquivo de nome de clientes fechado). Adicionar a nova informação também no arquivo do relatório (ao mesmo tempo) - isso eu ainda não consegui. Espero que tenha conseguido explicar melhor. Esse é a solução que trará mais produtividade, eficiência e eficácia ao trabalho que temos hoje em dia em emitir esses relatórios. Muito obrigada pela ajuda de vocês!!

Boa tarde, Tenho um problemão para resolver. E como estou começando a mexer com o código VBA no excel não tenho ideia de como solucionar isso. Tenho duas pastas excel diferentes que serão salvas na rede do escritório. Na pasta excel 1 há um banco de dados de clientes da empresa. Na pasta excel 2 há o relatório emitido por outro departamento da empresa com o nome e processos de cada cliente. o problema é o seguinte: o relatório emitido mensalmente pelo outro departamento há o mesmo cliente mais de uma vez na mesma planilha por conter erros ortográficos. Eu preciso deste relatório mensal para emitir um outro relatório, só que eu não posso usar nenhuma fórmula justamente porque contem esses erros ortográficos e os valores de um cliente irão aparecer em 3 clientes (que é o mesmo cliente na verdade, mas que por esses erros ortográficos o cliente aparece 3 vezes na mesma planilha). A solução que eu pensei foi a seguinte: Fazer um autocompletar. Origem do banco de dados: A pasta excel 1 que é o banco de dados dos clientes da empresa (está na rede mas está fechada e eu não quero que ela abra com a aquele comando Workbook("x").Open (ou algo assim rs)). Destino: Textbox de um formulário ou se for possível na própria célula da planilha. Será usando apenas uma coluna e uma planilha de cada pasta (origem/destino). Só que aí entra um outro problema.... E se o departamento tiver um novo nome do cliente que não está no banco de dados? O que eu pensei foi em que o departamento está habilitado a adicionar novos clientes e este será adicionado automaticamente na pasta excel de banco de dados (fechada). E se a pessoa apertar o botão "Adicionar Novo" com o nome do cliente já existente no banco de dados aparecerá o erro de cliente duplicado. Não sei se consegui explicar muito bem.... rsrs Qualquer dúvida, por favor, me informem. Segue a planilha como um exemplo do que eu consegui fazer até o momento, só que o banco de dados e o relatório estão em um mesmo arquivo e eu só consigo adicionar o nome de cliente novo na aba do banco de dados mas o mesmo não aparece na aba do relatório. https://www.sendspace.com/file/8ostvs O que eu fiz até o momento foi com base no link abaixo: http://guiadoexcel.com.br/auto-completar-em-excel-vba Vocês podem me ajudar, por favor? Muito obrigada mesmo!!