Ir ao conteúdo
  • Cadastre-se

Ajuda - Macro para excel! - VBA


maxcpv

Posts recomendados

Olá, 
Preciso de uma ajuda. 

Eu tenho uma Macro que faz a comparação de dois arquivos Excel, mas para que a mesma funcione, os dois arquivos precisam estar na mesma pasta que o arquivo da Macro, e também precisam estar abertos. 

A Macro funciona da seguinte maneira: 
Pergunta o nome dos arquivos; 
Usuário digita nome.extensão (uma vez para cada arquivo) 
Com tudo aberto, faz a comparação e a mesma é mostrada na própria Macro. 

Como preciso melhorar essa parte, a ideia é de que não seja necessário que os dois arquivos estejam abertos. 
Então a ideia que tenho, seria de que a Macro antes reconheceria a pasta em que a própria está, e nela buscaria os dois arquivos digitados anteriormente sem a necessidade de abrir os mesmos antes. 
Detalhe: A macro precisa reconhecer a pasta onde a mesma está, uma vez que ela será utilizada por vários usuários diferentes, ou seja, cada um salvaria em uma pasta diferente consequentemente.

Há alguma maneira de isso ser feito? Ou no mínimo, se tiverem de estar abertos, os mesmos serem abertos através da Macro?
 
Vou postar aqui o que já tá pronto nela:
 
Private Sub CommandButton1_Click()IniciarComparacaoEnd SubSub IniciarComparacao()      Dim fileName1 As String   Dim fileName2 As String   Dim fileResult As String   Dim filePath As String      Do While ((fileName1 = "") Or (fileName2 = ""))      fileName1 = InputBox("Report by BO XI 3.1 (filename):")      fileName2 = InputBox("Report by SAP BI 4.1 (filename):")      If ((fileName1 = "") Or (fileName2 = "")) Then         MsgBox ("Enter a valid filename (Must be in the same folder as this file.)")      End If   Loop         'fileName1 = "POLAPPE_004_31_WITHOUT_EXTEND.xlsx"   'fileName2 = "POLAPPE_004_R2_WITHOUT_EXTEND.xlsx"   fileResult = "output.xlsm"            Dim counterSpreadsheet As Integer   Dim counterDifferent As Integer   Dim counterSimilar As Integer      Dim reportFile1 As Workbook   Dim reportFile2 As Workbook   Dim reportResult As Workbook      Dim spreadSheet1 As Worksheet   Dim spreadSheet2 As Worksheet   Dim resultSpreadsheet As Worksheet         Set reportFile1 = Workbooks(fileName1)   Set reportFile2 = Workbooks(fileName2)   Set reportResult = Workbooks(fileResult)      Set spreadSheet1 = reportFile1.Worksheets(1)   Set spreadSheet2 = reportFile2.Worksheets(1)   Set resultSpreadsheet = reportResult.Worksheets(1)      counterSpreadsheet = 1   counterDifferent = 0 'Count different items within the report   counterSimilar = 0 'Count items between a defined tolerance      Do While (reportResult.Worksheets.Count < reportFile1.Worksheets.Count)      reportResult.Worksheets.Add Sheets(1)   Loop   Do While (counterSpreadsheet <= (reportFile1.Worksheets.Count))  'Counter <= number of spreadsheets      Set spreadSheet1 = reportFile1.Worksheets(counterSpreadsheet)      Set spreadSheet2 = reportFile2.Worksheets(counterSpreadsheet)      Set resultSpreadsheet = reportResult.Worksheets(counterSpreadsheet)      resultSpreadsheet.Name = spreadSheet1.Name      Call Comparacaorotina(spreadSheet1, spreadSheet2, resultSpreadsheet, counterDifferent, counterSimilar)      counterSpreadsheet = counterSpreadsheet + 1   Loop   MsgBox ("Task Finished." & vbCrLf & vbCrLf & "Different itens: " & counterDifferent & "" & vbCrLf & "Similar Items: " & counterSimilar)      End SubSub Comparacaorotina(spreadSheet1, spreadSheet2, resultSpreadsheet, counterDifferent, counterSimilar)   Dim rowCounter As Integer   rowCounter = 1   Dim columnCounter As Integer   columnCounter = 1      item1 = 0   item2 = 0      Dim statusColor As Integer 'True for acceptable   Dim cellRef As Range   Dim maxWidth As Integer   maxWidth = 1      Dim maxHeigth As Integer   maxHeigth = 1      Call getMaxColumnItems(spreadSheet1, maxWidth, maxHeigth)      Do While (rowCounter < (maxWidth + 1))      Do While (columnCounter < (maxHeigth + 1))         item1 = ""         item2 = ""         item1 = spreadSheet1.Cells(rowCounter, columnCounter).Value         item2 = spreadSheet2.Cells(rowCounter, columnCounter).Value         Set cellRef = resultSpreadsheet.Cells(rowCounter, columnCounter)                  If (item1 = item2) Then            If ((item1 <> "") Or (item2 <> "")) Then               statusColor = 4               cellRef = "="            Else               statusColor = 0                        End If                     Else  'Different            If ((IsNumeric(item1)) And (IsNumeric(item2))) Then                              cellRef = item1 - item2               If ((cellRef > (-0.0001)) And (cellRef < (0.0001))) Then                  statusColor = 5                  cellRef = "+-="                  counterSimilar = counterSimilar + 1               Else                  statusColor = 3                  counterDifferent = counterDifferent + 1               End If                        ElseIf ((Application.WorksheetFunction.IsText(item1)) And (Application.WorksheetFunction.IsText(item1))) Then                              statusColor = 3               cellRef = "DiffText"               counterDifferent = counterDifferent + 1                           Else               statusColor = 3               cellRef = "DiffType"               counterDifferent = counterDifferent + 1            End If         End If                  cellRef.Interior.ColorIndex = statusColor         columnCounter = columnCounter + 1      Loop      rowCounter = rowCounter + 1      columnCounter = 1   LoopEnd SubSub getMaxColumnItems(spreadsheet, maxWidth, maxHeight)   Dim rangeRef As Range   Set rangeRef = spreadsheet.UsedRange   maxWidth = rangeRef.SpecialCells(xlCellTypeLastCell).Row   maxHeight = rangeRef.SpecialCells(xlCellTypeLastCell).Column   End Sub
 
Desde já agradeço pela ajuda
Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...