06. april 2006 - 16:36
Der er
2 kommentarer og
1 løsning
Sammenkædning af 2 excel filer
Hej Eksperter
Jeg har 2 excel filer som skal kædes sammen på en eller anden smart måde
Jeg har nogle felter som skal bindes sammen, men de er ikke placeret ud for hinanden.
fil 1.xls
P009 Ting1
P009 Ting2
P010 Ting3
P011 Ting4
P011 Ting5
P012 Ting6
fil 2.xls
P009 20,00
P010 27,59
P011 51,35
P012 147,25
det skal så kædes sammen til:
fil 3.xls
P009 Ting1 20,00
P009 Ting2 20,00
P010 Ting3 27,59
P011 Ting4 51,35
P011 Ting5 51,35
P012 Ting6 147,25
06. april 2006 - 18:40
#1
Hvis det kun drejer sig om disse få poster, vil kopier og sæt ind nok være det nemmeste, men det er nu nok en længere liste.
Hvis du åbner fil 2.xls og fil 1.xls og markerer cellen du vil have din pris til at stå i taster = klikker på cellen hvor prisen står har du skabt forbindelse mellem de to dokumenter.
Det er praktiskt hvis du ændre på prisen på ting*
BG
14. april 2006 - 14:46
#3
VBA-koden anbringes i ThisWorkbook:
Dim xsti
Const fil1Navn = "fil 1.xls"
Const fil2Navn = "fil 2.xls"
Dim xlS1 As Object, xlS2 As Object, fil3SidsteRække
Sub workbook_activate()
hentSti
opretObject xlS1, fil1Navn
opretObject xlS2, fil2Navn
hentDataFrafil1 xlS1
hentPriserFrafil2 xlS2
xlS1.Quit
xlS2.Quit
Set xlS1 = Nothing
Set xlS2 = Nothing
MsgBox ("Overførsel af data & priser er afsluttet")
End Sub
Private Function findPris(pNr, xls)
Dim r
With xls
r = 1
While .Cells(r, 1) <> ""
If .Cells(r, 1) = pNr Then
findPris = .Cells(r, 2)
Exit Function
End If
r = r + 1
Wend
End With
findPris = "?"
End Function
Private Sub hentPriserFrafil2(xls)
Dim r, produktNr
With ActiveWorkbook.Sheets(1)
Cells(1, 1).Select
For r = 1 To fil3SidsteRække
produktNr = Cells(r, 1)
Cells(r, 3) = findPris(produktNr, xls)
Next r
End With
End Sub
Private Sub hentDataFrafil1(xls)
Dim r
With xls.Sheets(1)
.Cells(1, 1).Select
r = 1
While .Cells(r, 1) <> ""
ActiveWorkbook.Sheets(1).Cells(r, 1) = .Cells(r, 1) 'ProduktNr
ActiveWorkbook.Sheets(1).Cells(r, 2) = .Cells(r, 2) 'Navn
x = .Cells(r, 2)
r = r + 1
Wend
End With
fil3SidsteRække = r - 1
End Sub
Private Sub opretObject(xls As Object, filnavn As String)
Set xls = CreateObject("excel.application")
With xls
.Workbooks.Open (xsti + filnavn)
End With
End Sub
Private Sub hentSti()
xsti = ActiveWorkbook.Path
If Right(xsti, 1) <> "\" Then
xsti = xsti + "\"
End If
End Sub