Hente data fra to excel filer og merge i et

Via VBA kan det lade sig gøre - men du må beskrive spillereglerne lidt nærmere.

- Hvordan vælges filer?
- ID - er det i filnavnet?
- de andre poster?

Jeg har to andre filer. Den ene er en excelfil med 1500 records og den anden er en semikollon sepereret cvs fil med 115000 records. I sidst nævnte (CVS) ligger der navne med et unikt ID. I forstnævnte ligger der navne på ting, som førstnævnte ejer - kædet sammen med samme unikke ID.

Jeg skal så finde ud af hvem der ejer hvilke ting. Det skal gerne være en nogenlunde simpelproces, hvor man kan skifte filerne ud med ny data og så få en opdateret oversigt...

Jeg har ikke meget forstand på VBA andet end lidt ASP VBA programmering tidligere - men intet i Excel...

/J

Hvordan forestiller du dig resultatet af "sammenkædningen" skulle lagres?

Min idé var, at det skulle være i et nyt excel ark evt. med en makro... Alternativt kunne det være en Access fil der trak på arkene...

Nu nævner du Access - tænker du på at de 2 nævnte filer kunne indgår som tabeller - måske efter tilpasning, hvis nødvendigt?

Jaah, har tænkt tanken - så kunne man bare lave et SQL kald... evt som en "visning" så vidt jeg forstår kan man det rimelig simpelt... Det var mest for at gøre det simpelt, da udtrækkende kommer i excel/CVS... Så skal man jo nemlig til at overføre data hver gang...:) Men ser du Acces måden som simplere?

Database-tanken er jo fristende - da "Relationerne" netop kan udgøre sammenkædningen.

Når nye data kommer (Excel/CSV) - hvad så med de tidligere data?

Om Access er simplere - det kræver nok lidt mere analyse...

-

Du er velkommen til at sende et uddrag af de 2 filer til: pb@supertekst-it.dk

Jeg skal sådan set selv lave filerne - det er til et skoleprojekt... Har jeg ikke gjort endnu dog...

Men jeg tænker, at den tidligere data så bare skal slettes - for idéen må være, at det er samme type data man få i et udtræk fra to forskellige databaser (hvor den ene er cvs og den anden er excel fil) og så kan man bare bruge en funktion i excel til at vælge de to filer (som evt. bare kan hedde noget specfikt - fx "navne" og "data") og så vælger excel filen der samler dataerne selv resten ud baseret på den kolonne der hedder uniktID...

Kan man gøre det sådan?

Nu er jeg gået tilbage til Access løsningen. Har sammenkædet to excelfiler ind i access som opdaterer automatisk - super smart... Men nu bliver jeg helt i tvivl om det så er en  "Formular", "Rapport", eller hvad der skal til?

Hvis formular - så skulle sammen kædningen kunne ses - men du skal nok opbygge en forespørgsel, hvor begge tabeller indgår og så basere formularen på denne.

Uha... Jeg prøver lige... Jeg vender lige tilbage :)

Jeg kan fandeme ikke få det til at spille, sådan at den viser de rigtige data...:( Selvom jeg har oprettet relationer etc...

Men jeg har lige fundet ud af, at listerne skal være mulige at redigere i... Så måske det er smartere at lave det ud fra et SQL kald - kan man gemme sådan et som standard? Og så lave det muligt at smide over i excel?

Hov, nu lavede jeg en forespørgsel - der kan jeg sgu få en tabellignende oversigt der minder lidt om excel... Wuhuu!

Ser ud til at virke!

Fint - er vi færdige?

Hmm... Nu kom jeg lige til at lege lidt videre med det - for at se hvor fleksibelt det var... Det er IKKE fleksibelt - man kan ikke bare bytte excel arkene ud og så virker det stadig, så den model duer ikke. Røv!

Så den nye quiz hedder:
"Hvor let kan du lave en makro der sammenligner en csv og en excel fil - og tager alle de rækker ud fra de to filer hvor der er et match på et unikt id?"

:) Kan du hjælpe mig med det?

Det skal være en proces som kan simplificere det at gøre det, så selv en idiot kan klare det hurtigt...

Ja - alt kan lade sig gøre (næsten - det er det mit firma beskæftiger sig med hver dag).

Du må have nogler filer, som du så kan sende mig - en .CSV (reduceret) og .XLS.

Kan sendes til: pb@supertekst-it.dk

You've got mail :)

TIl at finde ud af? :)

Har ikke fået nogen mail - endnu! - så derfor ??

weird... den er afsendt... prøver lige igen!! :)

Sendt igen

Got it?

Ah, det kan jeg se du gjorde :)

Dim gemSti                      'PT.: samme mappe som SystemFlet-filen

Dim trans                        'objekt
Dim aRækTRANS
Dim linFelter(10)              'dimensioneret efter antal felter i STAM
Dim stamFil, transFil

Private Sub workbook_activate()
    hentSti
   
    MsgBox ("Vælg stam-fil")
    stamFil = Application.GetOpenFilename
   
    MsgBox ("Vælg TRANS-fil")
    transFil = Application.GetOpenFilename
   
    If stamFil = False Or transFil = False Then
        MsgBox ("Fil(er) ikke valgt - kørsel afbrydes")
        Exit Sub
    Else
        åbnTRANSfil transnavn
        udførFletning
        gemTRANSfil
        lukTRANSfil
       
    MsgBox ("Fletning er afsluttet")
    End If
End Sub

Private Sub hentSti()
    gemSti = ActiveWorkbook.Path
    If Right(gemSti, 1) <> "\" Then
        gemSti = gemSti + "\"
    End If
End Sub

Private Sub åbnTRANSfil(filnavn)
Rem trans-fil defineres og åbnes som Object
    Set trans = CreateObject("Excel.Application")
    With trans
        .Workbooks.Open transFil
        aRækTRANS = .ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Sub

Private Sub gemTRANSfil()
    trans.ActiveWorkbook.SaveAs gemSti + "Opdatering.xls"
End Sub

Private Sub lukTRANSfil()
    trans.ActiveWorkbook.Close
    trans.Application.Quit
    Set trans = Nothing
End Sub

Private Sub udførFletning()
Dim linie, tæller
 
    tæller = 0
   
    Open stamFil For Input As #1
    While Not EOF(1)
        Line Input #1, linie
        If tæller > 0 Then
            adskilLinie linie + ";"
            opdaterTRANS linFelter(0)
        End If
        tæller = tæller + 1
    Wend
    Close #1
End Sub

Private Sub adskilLinie(lin)
Dim p, slutFlag As Boolean, fCount
    slutFlag = False
    fCount = 0
   
    While slutFlag = False
        p = InStr(lin, ";")
        If p > 0 Then
            felt = Left(lin, p - 1)
            linFelter(fCount) = felt
            fCount = fCount + 1
           
            lin = Mid(lin, p + 1)
        Else
            slutFlag = True
        End If
    Wend
End Sub

Private Sub opdaterTRANS(kNr)
Rem søg efter KNR i trans-filen
    fundetræk = findID(kNr)
    If fundetræk > 0 Then
        overførTilTrans fundetræk
    End If
End Sub

Private Function findID(kNr)
Dim id2
    id2 = Mid(kNr, 2, 6)
   
    With trans.Sheets(1).Range("a1:a" + CStr(aRækTRANS))
        Set c = .Find(id2, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findID = c.Row
        Else
            findID = 0
        End If
    End With
End Function

Private Sub overførTilTrans(ræk)
    With trans
        For kolonne = 2 To 10
            .Cells(ræk, kolonne) = linFelter(kolonne - 1)
        Next kolonne
    End With
End Sub

tusind tak for hjælpen! Det er satme nice :)

Selv tak