Avatar billede graspman Nybegynder
07. juni 2007 - 12:24 Der er 4 kommentarer

VBA macro der indlæser 2 regneark og samenligner arkene

Hej,

jeg har 2 regneark jeg gerne vil have sammenlignet.
Jeg har lavet en regneark hvor jeg har sat 2 stk "selectfile" kontrol elementer ind (selectfile1 og selectfile2). Formålet er at brugeren kan vælge de 2 filer der skal sammenlignes.
Efterfølgende har jeg lavet 2 teksbokse, hvor brugeren skal angive hvilken kolonne der skal sammenlignes på. F.eks. i regneark 1, skal det være kolonne "A", der skal bruges som søgeparameter i regneark 2, kolonne "B".

Søgningen:
Hvis værdien fra regneark 1 celle "A1", ikke findes i regenark 2 kolonnen "B", skal hele data fra celle A1-A5 (regneark 1), skrives til enten en ny fil eller blot indsættes i det åbne regneark, således man kan se forskellen på de 2 regneark.

Jeg vil sætte pris på noget kode eksempler eller endnu bedre en løsning. Løsningen skal helst være meget brugervenlig.

På forhånd tak.
Avatar billede supertekst Ekspert
08. juni 2007 - 11:29 #1
Koden indsættes i en separat XLS-fil - ark1:

Dim xsti

Const RækSam = 1                    'antal rækker til sammenligning
Const RækVis = 5                    'antal rækker til visning

Rem Test-data
Const fil1 = "fil1.xls"
Const fil2 = "fil2.xls"
Const k1 = "A"
Const k2 = "F"

Dim xls1, xls2, okFlag As Boolean
Sub BegyndSammenligning()
Rem find system-sti
    xsti = ActiveWorkbook.Path
    If Right(xsti, 1) <> "\" Then
        xsti = xsti + "\"
    End If
   
Rem Slet gl. indhold + sæt Flag
    Cells.Clear
    okFlag = True
   
Rem Sæt id i system
    Cells(1, 1) = fil1 + " [" + k1 + "]"
    Cells(1, 2) = fil2 + " [" + k2 + "]"
   
    åbnXls xls1, xsti + fil1
    åbnXls xls2, xsti + fil2
   
Rem Sammenlign - hvis uens - sæt flag
    For ræk = 1 To RækSam
        If xls1.Range(k1 + CStr(ræk)) <> xls2.Range(k2 + CStr(ræk)) Then
            okFlag = False
        End If
    Next ræk
   
Rem Vis rækker hvis forskel
    If okFlag = False Then
        For ræk = 1 To RækVis
            Cells(ræk + 1, 1) = xls1.Range(k1 + CStr(ræk))
            Cells(ræk + 1, 2) = xls2.Range(k2 + CStr(ræk))
        Next ræk
    End If
   
Rem Luk filerne
    xls1.Application.Quit
    Set xls1 = Nothing
   
    xls2.Application.Quit
    Set xls2 = Nothing
   
Rem tilpas kolonnebredde
    ActiveSheet.Columns.AutoFit
End Sub
Private Sub åbnXls(xls, fil)
    Set xls = CreateObject("Excel.application")
    With xls
        .Workbooks.Open fil
    End With
End Sub
Avatar billede graspman Nybegynder
20. juni 2007 - 09:23 #2
jeg prøver lige
Avatar billede supertekst Ekspert
20. juni 2007 - 09:50 #3
ok
Avatar billede graspman Nybegynder
02. juli 2007 - 15:38 #4
Hej,

Ideen var at den skulle tage f.eks ark 1 - celle A1, og se i ark 2 om værdien var der. Dvs. den skal se hele ark 2 igennem.
Efterfølgende skal den tage næste værdi i ark 1 og se om værdien eksistere i ark 2 - osv...
Den macro du har skrvet - kigger den ikke blot om ark1.A1 = ark2=A1.

På forhånd tak
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester