Avatar billede h_lambert Nybegynder
09. juli 2007 - 12:39 Der er 4 kommentarer og
1 løsning

Sammenkæd to dokumenter i Acces

Hej Eksperter

Jeg har to filer, som jeg ønsker sammenkædet ved hjælp af acces. Det drejer sig om en fil fra en Prisdatabase, som skal kædes sammen med priser fra en hjemmeside. Priserne fra prisdatabasen er i .csv-format mens priserne fra hjemmesiden er i .xml format.
Filen fra prisdatabasen indeholder over 100.000 varenumre, mens vores prisfil kun indeholder ca 300. Jeg ønsker så priserne for de samme varnumre sammenkædet, således de kan sammenlignes.

Kan i hjælpe mig med hvordan dette praktisk kan lade sig gøre i acces. Eller er der et andet program der vil være bedre at benytte.

På forhånd tak

Hans Lambert Pederen
Avatar billede supertekst Ekspert
10. juli 2007 - 09:36 #1
Er det "kun" et spørgsmål om at få et sammenligningsgrundlag - f.eks. i er regneark?
Der skulle nok være en mulighed via VBA...
Avatar billede h_lambert Nybegynder
10. juli 2007 - 19:10 #2
Tak for dit svar.

Hvad kan jeg bruge dette VBA til, og hvor finder jeg info omkring det?
Avatar billede supertekst Ekspert
10. juli 2007 - 20:47 #3
VBA er Visual Basic for Applications (programmeringssproget i office-pakken) - det kan jeg godt gøre et forsøg med.

Hvad svarer du til mit spørgsmål?

Hvis ja - så er du velkommen se at sende et uddrag af filerne til: pb@supertekst-it.dk
Avatar billede supertekst Ekspert
27. september 2007 - 16:46 #4
Her er så koden, der blev indlagt under forskellige faner i regnearket:

Rem Hent EBDpriser
Rem ==============
Const TXTfilnavn = "EDBPriser.txt"          '<---------- tilpasses
Const opslagsArk = "Kostpris"                '<---------- evt. tilpasses
Dim XantalRækker
Dim xSti, ræk, count
Public Sub UdførImport()
    With ActiveWorkbook
        .Sheets(opslagsArk).Activate
        XantalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    End With

    ActiveWorkbook.Sheets("edbpriser").Activate

Rem slet gl. indhold
        ActiveSheet.Range("A2:AZ65000").ClearContents

    findSti
    åbnImportFil
    Columns.AutoFit
    MsgBox ("Import af EDBPriser-fil afsluttet - " + CStr(ræk - 1) + " stk")
End Sub
Private Sub findSti()
    xSti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Private Sub åbnImportFil()
    ræk = 1
    count = 1
    Open xSti + TXTfilnavn For Input As #1
        While Not EOF(1)
            Line Input #1, linie
            adskilLinie linie + ";"
            Application.StatusBar = CStr(count) + "/" + CStr(ræk)
            count = count + 1
        Wend
        Close #1
End Sub
Private Sub adskilLinie(linie)
Dim lin, kol
    kol = 1
    While InStr(linie, ";") > 0
        p = InStr(linie, ";")
        If p > 0 Then
            felt = Left(linie, p - 1)
            If ræk > 1 And kol = 1 Then
                If felt = "" Or findesVarenr(felt) = False Then
                    Exit Sub
                End If
            End If
           
            Cells(ræk, kol) = felt
            kol = kol + 1
            linie = Mid(linie, p + 1)
        Else
            Stop
        End If
    Wend
    ræk = ræk + 1
End Sub
Private Function findesVarenr(Vnr)
    With Worksheets(opslagsArk).Range("c2:c" + CStr(XantalRækker))
        Set c = .Find(Vnr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findesVarenr = True
        Else
            findesVarenr = False
        End If
    End With
End Function

Rem Hent KOSTPRIS fra XML-fil
Rem =========================
Const XMLfilnavn = "kostpris.txt"          '<---------- tilpasses

Dim xSti, prAntal, prLinie
Public Sub UdførImport()
    prAntal = 0
    findSti
    åbnImportFil
   
    Columns.AutoFit
   
    MsgBox ("Import af XML-fil afsluttet")
End Sub
Private Sub findSti()
    xSti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Private Sub åbnImportFil()
    Open xSti + XMLfilnavn For Input As #1
        While Not EOF(1)
'            Line Input #1, linie
            Input #1, linie
         
            If InStr(linie, "<PRODUCT>") > 0 Then
                startProduct
            Else
                If InStr(linie, "<PROD_NUM>") > 0 Then
                    behandlProduct linie
                Else
                    If InStr(linie, "<PROD_NAME>") > 0 Then
                        behandlProduct linie
                    Else
                        If InStr(linie, "<EDBPriser_NUM>") > 0 Then
                            behandlProduct linie
                        Else
                            If InStr(linie, "<PROD_WEIGHT>") > 0 Then
                                    behandlProduct linie
                            Else
                                If InStr(linie, "<PROD_COST_PRICE>") > 0 Then
                                    behandlProduct linie
                                Else
                                    If InStr(linie, "<STOCK_COUNT>") > 0 Then
                                        behandlProduct linie
                                    Else
                                        If InStr(linie, "</PRODUCT>") > 0 Then
                                            afslutProduct
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Wend
    Close #1
End Sub
Private Sub startProduct()
    prAntal = prAntal + 1
    prLinie = 0
End Sub
Private Sub afslutProduct()
    prLinie = 0
End Sub
Private Sub behandlProduct(linie)
Dim id, data
    id = ""
    data = ""
    isolerData linie, id, data
   
    If id <> "" Then
        prLinie = prLinie + 1
       
Rem hvis Første product- sæt overskrift
        If prAntal = 1 Then
            Cells(1, prLinie) = id
        End If
       
        Cells(prAntal + 1, prLinie) = data
    Else
        MsgBox ("Systemfejl - feltID / data ej fundet")
        Stop
    End If
End Sub
Private Sub isolerData(linie, id, data)
Dim p, lin
    lin = LTrim(linie)
    p = InStr(lin, ">")
    If p > 0 Then
        id = Left(lin, p)
        lin = Mid(lin, p + 1)
        p = InStr(lin, "<")
        If p > 0 Then
            data = Left(lin, p - 1)
            Exit Sub
        Else
            Stop
        End If
    Else
        MsgBox ("Systemfejl - '>' mangler")
        Stop
    End If
End Sub

Rem PRIS -SAMMENLIGNING
Rem ===================
Dim aRækVP, aRækEDB, aRækCost
Dim LPræk, ejLPræk
Dim edbNr, placering, edbRæk, costRæk, vorPris
Sub prisSammenligning()
    HouseKeeping
    gennemløbVorPriser
   
    MsgBox ("Prissammenligning opbygget")
End Sub
Private Sub HouseKeeping()
Rem find antal rækker på de 3 pris-ark
    aRækVP = antalRækker("VorPriser")
    aRækEDB = antalRækker("EDBPriser")
    aRækCost = antalRækker("Kostpris")
   
    With ActiveWorkbook
        .Sheets("Laveste pris").Activate
       
Rem slet gl. indhold
        .ActiveSheet.Range("A2:AA65000").ClearContents
    End With
   
    LPræk = 2
   
    With ActiveWorkbook
        .Sheets("ej Laveste pris").Activate
Rem slet gl. indhold
        .ActiveSheet.Range("A2:AA65000").ClearContents
    End With
   
    ejLPræk = 2
   
End Sub
Private Function antalRækker(ark)
    With ActiveWorkbook
        .Sheets(ark).Activate
        antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Function
Private Sub gennemløbVorPriser()
Dim vægt, fragtPris As Single, tillæg
    With ActiveWorkbook
       
        For ræk = 2 To aRækVP
            .Sheets("VorPriser").Activate
            edbNr = ActiveSheet.Cells(ræk, 6)
            vorPris = ActiveSheet.Cells(ræk, 4)
            placering = ActiveSheet.Cells(ræk, 5)
           
            edbRæk = findEDB(edbNr)
            costRæk = findCost(edbNr)
           
            If costRæk <> 0 Then
Rem hent vægt
                vægt = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 4)
Rem Beregn / indsæt fragtpris
                If vægt <> 0 And vægt <> "" Then
                    fragtPris = ActiveWorkbook.Sheets("Fragt").beregnFragtPris(vægt)
                    tillæg = ((vorPris * 0.1) / 100) + 1.45    'DK-grbyr
                    fragtPris = fragtPris + tillæg
                    fragtPris = Round(fragtPris)
                Else
                    fragtPris = 0
                End If
            Else
                vægt = 0
                fragtPris = 0
            End If
           
            If edbRæk <> 0 Then
                If vorPris + fragtPris <= ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 22) Then
                    lavestePris edbRæk, costRæk, vorPris, fragtPris
                Else
                    ejlavestePris edbRæk, costRæk, vorPris, placering, fragtPris
                End If
            End If
        Next ræk
    End With
End Sub
Private Function findEDB(nr)
    With Worksheets("edbpriser").Range("a2:aF" + CStr(aRækEDB))
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findEDB = c.Row
        Else
            findEDB = 0
        End If
    End With
End Function
Private Function findCost(nr)
    With Worksheets("kostpris").Range("a2:aF" + CStr(aRækCost))
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findCost = c.Row
        Else
            findCost = 0
        End If
    End With
End Function
Private Sub lavestePris(edbRæk, costRæk, vorPris, fragtPris As Single)
Dim siteLink
    With ActiveWorkbook
        .Sheets("Laveste pris").Activate

Rem Site + Varenummer
        siteLink = "http://www." + ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 4) + _
            "/Products/Listprices.asp?ID=" + CStr(ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 1))
       
        With .Worksheets("Laveste pris")
            .Hyperlinks.Add .Range("B" + CStr(LPræk)), siteLink
        End With
       
        If costRæk > 0 Then
Rem Varenavn
            ActiveSheet.Cells(LPræk, 1) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 2)
Rem Indkøbspris
            ActiveSheet.Cells(LPræk, 3) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 5)
Rem Vort Varenr
            ActiveSheet.Cells(LPræk, 12) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 1)
Rem Vort Lager
            ActiveSheet.Cells(LPræk, 13) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 6)
        End If
       
Rem Fragtpris
        ActiveSheet.Cells(LPræk, 4) = fragtPris
       
Rem Vores pris
        ActiveSheet.Cells(LPræk, 5) = vorPris
       
Rem Vores pris incl fragt (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 5).Address
        adr2 = ActiveSheet.Cells(LPræk, 4).Address
        ActiveSheet.Cells(LPræk, 6).Formula = "=" & adr1 & "+" & adr2
        sletDollar LPræk, 6

Rem Næstelaveste pris incl fragt
        ActiveSheet.Cells(LPræk, 7) = ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 23)
       
Rem Prisforskel (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 7).Address
        adr2 = ActiveSheet.Cells(LPræk, 6).Address
        ActiveSheet.Cells(LPræk, 8).Formula = "=" & adr1 & "-" & adr2
        sletDollar LPræk, 8

Rem Salgspris ved laveste pris excl fragt (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 5).Address
        adr2 = ActiveSheet.Cells(LPræk, 8).Address
        ActiveSheet.Cells(LPræk, 9).Formula = "=" & "(" & adr1 & "+" & adr2 & "-1)" & "/1.25"
        sletDollar LPræk, 9

Rem DB ved laveste pris (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 9).Address
        adr2 = ActiveSheet.Cells(LPræk, 3).Address
        ActiveSheet.Cells(LPræk, 10).Formula = "=" & adr1 & "-" & adr2
        sletDollar LPræk, 10

Rem DG ved laveste pris (Formel)
        If ActiveSheet.Cells(LPræk, 9) <> 0 Then
            adr1 = ActiveSheet.Cells(LPræk, 10).Address
            adr2 = ActiveSheet.Cells(LPræk, 9).Address
            ActiveSheet.Cells(LPræk, 11).Formula = "=" & "(" & adr1 & "/" & adr2 & ") *100"
            sletDollar LPræk, 11
        End If
    End With
   
    LPræk = LPræk + 1
    ActiveSheet.Columns.AutoFit
End Sub
Private Sub sletDollar(ræk, kol)
Dim celle1, celle2
    celle1 = ActiveSheet.Cells(ræk, kol).Formula
    celle2 = Replace(celle1, "$", "", 1, Len(celle1))
    ActiveSheet.Cells(ræk, kol).Formula = celle2
End Sub
Private Sub ejlavestePris(edbRæk, costRæk, vorPris, placering, fragtPris As Single)
    With ActiveWorkbook
        .Sheets("Ej Laveste pris").Activate
       
Rem Site + Varenummer
        siteLink = "http://www." + ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 4) + _
            "/Products/Listprices.asp?ID=" + CStr(ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 1))
       
        With .Worksheets("Ej laveste pris")
            .Hyperlinks.Add .Range("B" + CStr(ejLPræk)), siteLink
        End With
     
Rem Placering
        ActiveSheet.Cells(ejLPræk, 3) = placering

        If costRæk > 0 Then
Rem Varenavn
            ActiveSheet.Cells(ejLPræk, 1) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 2)
Rem Indkøbspris
            ActiveSheet.Cells(ejLPræk, 4) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 5)
Rem Vort Varenr
            ActiveSheet.Cells(ejLPræk, 13) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 1)
Rem Vort Lager
            ActiveSheet.Cells(ejLPræk, 14) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 6)
        End If
   
Rem Fragtpris
        ActiveSheet.Cells(ejLPræk, 5) = fragtPris
   
Rem Vores pris
        ActiveSheet.Cells(ejLPræk, 6) = vorPris
       
Rem Vores pris incl fragt (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 6).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 5).Address
        ActiveSheet.Cells(ejLPræk, 7).Formula = "=" & adr1 & "+" & adr2
        sletDollar ejLPræk, 7

Rem Laveste pris incl fragt
        ActiveSheet.Cells(ejLPræk, 8) = ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 22)
       
Rem Prisforskel (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 7).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 8).Address
        ActiveSheet.Cells(ejLPræk, 9).Formula = "=" & adr1 & "-" & adr2
        sletDollar ejLPræk, 9
   
Rem Salgspris ved laveste pris excl. fragt (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 6).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 9).Address
        ActiveSheet.Cells(ejLPræk, 10).Formula = "=" & "(" & adr1 & "-" & adr2 & "-1)" & "/1.25"
        sletDollar ejLPræk, 10

Rem DB ved laveste pris (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 10).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 4).Address
        ActiveSheet.Cells(ejLPræk, 11).Formula = "=" & adr1 & "-" & adr2
        sletDollar ejLPræk, 11

Rem DG ved laveste pris (Formel)
        If ActiveSheet.Cells(ejLPræk, 10) <> 0 Then
            adr1 = ActiveSheet.Cells(ejLPræk, 11).Address
            adr2 = ActiveSheet.Cells(ejLPræk, 10).Address
            ActiveSheet.Cells(ejLPræk, 12).Formula = "=" & "(" & adr1 & "/" & adr2 & ") *100"
            sletDollar ejLPræk, 12
        End If
    End With
   
    ejLPræk = ejLPræk + 1
    ActiveSheet.Columns.AutoFit
End Sub
Private Sub CommandButton1_Click()
    prisSammenligning
End Sub
Private Sub CommandButton2_Click()
    ActiveWorkbook.Sheets("kostpris").UdførImport
End Sub
Private Sub CommandButton3_Click()
    ActiveWorkbook.Sheets("edbpriser").UdførImport
End Sub

Rem Fragtberegning
rem ==============
Rem PRIS -SAMMENLIGNING
Rem ===================
Dim aRækVP, aRækEDB, aRækCost
Dim LPræk, ejLPræk
Dim edbNr, placering, edbRæk, costRæk, vorPris
Sub prisSammenligning()
    HouseKeeping
    gennemløbVorPriser
   
    MsgBox ("Prissammenligning opbygget")
End Sub
Private Sub HouseKeeping()
Rem find antal rækker på de 3 pris-ark
    aRækVP = antalRækker("VorPriser")
    aRækEDB = antalRækker("EDBPriser")
    aRækCost = antalRækker("Kostpris")
   
    With ActiveWorkbook
        .Sheets("Laveste pris").Activate
       
Rem slet gl. indhold
        .ActiveSheet.Range("A2:AA65000").ClearContents
    End With
   
    LPræk = 2
   
    With ActiveWorkbook
        .Sheets("ej Laveste pris").Activate
Rem slet gl. indhold
        .ActiveSheet.Range("A2:AA65000").ClearContents
    End With
   
    ejLPræk = 2
   
End Sub
Private Function antalRækker(ark)
    With ActiveWorkbook
        .Sheets(ark).Activate
        antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Function
Private Sub gennemløbVorPriser()
Dim vægt, fragtPris As Single, tillæg
    With ActiveWorkbook
       
        For ræk = 2 To aRækVP
            .Sheets("VorPriser").Activate
            edbNr = ActiveSheet.Cells(ræk, 6)
            vorPris = ActiveSheet.Cells(ræk, 4)
            placering = ActiveSheet.Cells(ræk, 5)
           
            edbRæk = findEDB(edbNr)
            costRæk = findCost(edbNr)
           
            If costRæk <> 0 Then
Rem hent vægt
                vægt = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 4)
Rem Beregn / indsæt fragtpris
                If vægt <> 0 And vægt <> "" Then
                    fragtPris = ActiveWorkbook.Sheets("Fragt").beregnFragtPris(vægt)
                    tillæg = ((vorPris * 0.1) / 100) + 1.45    'DK-grbyr
                    fragtPris = fragtPris + tillæg
                    fragtPris = Round(fragtPris)
                Else
                    fragtPris = 0
                End If
            Else
                vægt = 0
                fragtPris = 0
            End If
           
            If edbRæk <> 0 Then
                If vorPris + fragtPris <= ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 22) Then
                    lavestePris edbRæk, costRæk, vorPris, fragtPris
                Else
                    ejlavestePris edbRæk, costRæk, vorPris, placering, fragtPris
                End If
            End If
        Next ræk
    End With
End Sub
Private Function findEDB(nr)
    With Worksheets("edbpriser").Range("a2:aF" + CStr(aRækEDB))
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findEDB = c.Row
        Else
            findEDB = 0
        End If
    End With
End Function
Private Function findCost(nr)
    With Worksheets("kostpris").Range("a2:aF" + CStr(aRækCost))
        Set c = .Find(nr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findCost = c.Row
        Else
            findCost = 0
        End If
    End With
End Function
Private Sub lavestePris(edbRæk, costRæk, vorPris, fragtPris As Single)
Dim siteLink
    With ActiveWorkbook
        .Sheets("Laveste pris").Activate

Rem Site + Varenummer
        siteLink = "http://www." + ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 4) + _
            "/Products/Listprices.asp?ID=" + CStr(ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 1))
       
        With .Worksheets("Laveste pris")
            .Hyperlinks.Add .Range("B" + CStr(LPræk)), siteLink
        End With
       
        If costRæk > 0 Then
Rem Varenavn
            ActiveSheet.Cells(LPræk, 1) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 2)
Rem Indkøbspris
            ActiveSheet.Cells(LPræk, 3) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 5)
Rem Vort Varenr
            ActiveSheet.Cells(LPræk, 12) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 1)
Rem Vort Lager
            ActiveSheet.Cells(LPræk, 13) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 6)
        End If
       
Rem Fragtpris
        ActiveSheet.Cells(LPræk, 4) = fragtPris
       
Rem Vores pris
        ActiveSheet.Cells(LPræk, 5) = vorPris
       
Rem Vores pris incl fragt (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 5).Address
        adr2 = ActiveSheet.Cells(LPræk, 4).Address
        ActiveSheet.Cells(LPræk, 6).Formula = "=" & adr1 & "+" & adr2
        sletDollar LPræk, 6

Rem Næstelaveste pris incl fragt
        ActiveSheet.Cells(LPræk, 7) = ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 23)
       
Rem Prisforskel (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 7).Address
        adr2 = ActiveSheet.Cells(LPræk, 6).Address
        ActiveSheet.Cells(LPræk, 8).Formula = "=" & adr1 & "-" & adr2
        sletDollar LPræk, 8

Rem Salgspris ved laveste pris excl fragt (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 5).Address
        adr2 = ActiveSheet.Cells(LPræk, 8).Address
        ActiveSheet.Cells(LPræk, 9).Formula = "=" & "(" & adr1 & "+" & adr2 & "-1)" & "/1.25"
        sletDollar LPræk, 9

Rem DB ved laveste pris (Formel)
        adr1 = ActiveSheet.Cells(LPræk, 9).Address
        adr2 = ActiveSheet.Cells(LPræk, 3).Address
        ActiveSheet.Cells(LPræk, 10).Formula = "=" & adr1 & "-" & adr2
        sletDollar LPræk, 10

Rem DG ved laveste pris (Formel)
        If ActiveSheet.Cells(LPræk, 9) <> 0 Then
            adr1 = ActiveSheet.Cells(LPræk, 10).Address
            adr2 = ActiveSheet.Cells(LPræk, 9).Address
            ActiveSheet.Cells(LPræk, 11).Formula = "=" & "(" & adr1 & "/" & adr2 & ") *100"
            sletDollar LPræk, 11
        End If
    End With
   
    LPræk = LPræk + 1
    ActiveSheet.Columns.AutoFit
End Sub
Private Sub sletDollar(ræk, kol)
Dim celle1, celle2
    celle1 = ActiveSheet.Cells(ræk, kol).Formula
    celle2 = Replace(celle1, "$", "", 1, Len(celle1))
    ActiveSheet.Cells(ræk, kol).Formula = celle2
End Sub
Private Sub ejlavestePris(edbRæk, costRæk, vorPris, placering, fragtPris As Single)
    With ActiveWorkbook
        .Sheets("Ej Laveste pris").Activate
       
Rem Site + Varenummer
        siteLink = "http://www." + ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 4) + _
            "/Products/Listprices.asp?ID=" + CStr(ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 1))
       
        With .Worksheets("Ej laveste pris")
            .Hyperlinks.Add .Range("B" + CStr(ejLPræk)), siteLink
        End With
     
Rem Placering
        ActiveSheet.Cells(ejLPræk, 3) = placering

        If costRæk > 0 Then
Rem Varenavn
            ActiveSheet.Cells(ejLPræk, 1) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 2)
Rem Indkøbspris
            ActiveSheet.Cells(ejLPræk, 4) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 5)
Rem Vort Varenr
            ActiveSheet.Cells(ejLPræk, 13) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 1)
Rem Vort Lager
            ActiveSheet.Cells(ejLPræk, 14) = ActiveWorkbook.Sheets("kostpris").Cells(costRæk, 6)
        End If
   
Rem Fragtpris
        ActiveSheet.Cells(ejLPræk, 5) = fragtPris
   
Rem Vores pris
        ActiveSheet.Cells(ejLPræk, 6) = vorPris
       
Rem Vores pris incl fragt (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 6).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 5).Address
        ActiveSheet.Cells(ejLPræk, 7).Formula = "=" & adr1 & "+" & adr2
        sletDollar ejLPræk, 7

Rem Laveste pris incl fragt
        ActiveSheet.Cells(ejLPræk, 8) = ActiveWorkbook.Sheets("edbpriser").Cells(edbRæk, 22)
       
Rem Prisforskel (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 7).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 8).Address
        ActiveSheet.Cells(ejLPræk, 9).Formula = "=" & adr1 & "-" & adr2
        sletDollar ejLPræk, 9
   
Rem Salgspris ved laveste pris excl. fragt (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 6).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 9).Address
        ActiveSheet.Cells(ejLPræk, 10).Formula = "=" & "(" & adr1 & "-" & adr2 & "-1)" & "/1.25"
        sletDollar ejLPræk, 10

Rem DB ved laveste pris (Formel)
        adr1 = ActiveSheet.Cells(ejLPræk, 10).Address
        adr2 = ActiveSheet.Cells(ejLPræk, 4).Address
        ActiveSheet.Cells(ejLPræk, 11).Formula = "=" & adr1 & "-" & adr2
        sletDollar ejLPræk, 11

Rem DG ved laveste pris (Formel)
        If ActiveSheet.Cells(ejLPræk, 10) <> 0 Then
            adr1 = ActiveSheet.Cells(ejLPræk, 11).Address
            adr2 = ActiveSheet.Cells(ejLPræk, 10).Address
            ActiveSheet.Cells(ejLPræk, 12).Formula = "=" & "(" & adr1 & "/" & adr2 & ") *100"
            sletDollar ejLPræk, 12
        End If
    End With
   
    ejLPræk = ejLPræk + 1
    ActiveSheet.Columns.AutoFit
End Sub
Private Sub CommandButton1_Click()
    prisSammenligning
End Sub
Private Sub CommandButton2_Click()
    ActiveWorkbook.Sheets("kostpris").UdførImport
End Sub
Private Sub CommandButton3_Click()
    ActiveWorkbook.Sheets("edbpriser").UdførImport
End Sub
Avatar billede supertekst Ekspert
29. november 2007 - 16:42 #5
Måske skulle vi afslutte dette spm.
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
IT-kurser om Microsoft 365, sikkerhed, personlig vækst, udvikling, digital markedsføring, grafisk design, SAP og forretningsanalyse.

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