Hent data fra fil

Ja -
Skal det importerede beløb adderes til evt. bestående beløb?
Er der tale om fortegn i importen

Er lejelisten i sorteret orden.
Hvor mange linier er der i denne - ca. ?

Hvis du har mulighed for at sende kopi/uddrag af begge filer - så vil det lette "ekspeditionen" - > pb@supertekst-it.dk

Ja, lejelisten er i sorteret orden og alle lejenumre har 10 cifre og beløbet skal udskrives i kroner..

Kode anbringes i Lejelistens ark1 i VBA
Tekstfilen anbringes i samme Mappe som Lejelisten
Koden iværksættes p.t. fra VBA - men ellers opret en knap og forbind den med:
Public Sub udførImport


Const importFilnavn = "import.txt"          'kan tilpasses
Dim sti, antalRæk
Public Sub udførImport()
Rem hentsti
    sti = ActiveWorkbook.Path
    If Right(sti, 1) <> "\" Then
        sti = sti + "\"
    End If
   
Rem antalrækker i lejeliste
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem udfør importen
    importer
   
End Sub
Private Sub importer()
Dim lejenr, beløb, lejerRæk

    Open sti + importFilnavn For Input As #1
Rem indlæs overskrift
    Input #1, txt1, txt2
   
    While Not EOF(1)
        Input #1, lejenr, beløb
        lejerRæk = findLejer(lejenr)
        If lejerRæk > 0 Then
            opdaterbeløb lejerRæk, beløb
        Else
            MsgBox ("LejerNr.: " + CStr(lnr) + " ikke fundet")
        End If
    Wend
   
    Close #1
End Sub
Private Function findLejer(lnr)
Rem find lejenr i liste
    For r = 2 To antalRæk
        If Cells(r, 3) = lnr Then
            findLejer = r
            Exit Function
        End If
    Next r
    findLejer = 0
End Function
Private Sub opdaterbeløb(ræk, beløb)
    Cells(ræk, 4) = Cells(ræk, 4) + beløb
End Sub

Hmm... jeg får denne fejl: Ambiguos name deteced: udførimport

Dette her hører IKKE med til koden:

Kode anbringes i Lejelistens ark1 i VBA
Tekstfilen anbringes i samme Mappe som Lejelisten
Koden iværksættes p.t. fra VBA - men ellers opret en knap og forbind den med:
Public Sub udførImport <<<<<<--------------------- det var en del af forklaringen..
--------------------------------------------------

Oki.... prøver lige igen ;)

Ok, nu kører den, nices, men den finder ingen lejenr.

og jeg trykker ok de ala de 10 linier der er ;)

00200201, 0000003000
00200202, 0000003000
00200203, 0000003000
00200204, 0000003000
00200205, 0000003000
00200206, 0000003000
00200207, 0000003000
00200208, 0000003000
00200209, 0000003000
00200210, 0000003000


Mit regneark:

lejenr    Navn    adresse    beløb
100200201           
100200202           
100200203           
100200204           
100200205           
100200206           
100200207           
100200208           
100200209           
100200210

Ok, nu kører den, nices, men den finder ingen lejenr.

og jeg trykker ok de ala de 10 linier der er ;)

100200201, 0000003000
100200202, 0000003000
100200203, 0000003000
100200204, 0000003000
100200205, 0000003000
100200206, 0000003000
100200207, 0000003000
100200208, 0000003000
100200209, 0000003000
100200210, 0000003000


Mit regneark:

lejenr    Navn    adresse    beløb
100200201           
100200202           
100200203           
100200204           
100200205           
100200206           
100200207           
100200208           
100200209           
100200210

Jeg har testet med 7-ciff. lejenr og der var ingen problemer med opdateringen

Jeg prøver med dit testgrundlag og vender tilbage.

Hvordan er dit lejenr formateret i Lejelisten?

Nu er det formateret som tal...havde som tekst i starten og troede at det var der problemet gemte sig...

prøvede lige med 7 cifre....der sker heller ikke såmeget ....

PS: Jeg anvender denne opstilling i LEJELISTEN iflg. dit spørgsmål:
Navn          Adresse    Leje nr.      Beløb
XXXX          XXXX        0123456        80,00-

altså lejenr. i kolonne C.

Hvis Lejenr er i kolonne A - så ret følgende i denne function:


Private Function findLejer(lnr)
Rem find lejenr i liste
    For r = 2 To antalRæk
        If Cells(r, 1) = lnr Then    '<----------- p.t.:(r,3)
            findLejer = r
            Exit Function
        End If
    Next r
    findLejer = 0
End Function

Ok, so far...... det virker, den henter og opdatere beløbet...

Men... 0000003000 skulle gerne blive til 30,00- og ikke 24000 som nu ;)

den opdaterer heller ikke linie 1 selvom lejeren findes ;(

Hmm....aner ikke hvorfor den skrev 24000, nu skriver den som den skal 3000

Private Sub opdaterbeløb(ræk, beløb)
    Cells(ræk, 4) = Cells(ræk, 4) + beløb / 100
End Sub

Ændrede ovenstående..... kan man indsætte 2 decimaler via den Sub??

Første lejer - programmet antager, at linie 1 i importfilen er overskrifter - da dette ikke er tilfældet så sletter du følgende:

Private Sub importer()
Dim lejenr, beløb, lejerRæk

    Open sti + importFilnavn For Input As #1
Rem indlæs overskrift            '<---- slettes
    Input #1, txt1, txt2          '<---- slettes
   
    While Not EOF(1)
        Input #1, lejenr, beløb
        lejerRæk = findLejer(lejenr)
        If lejerRæk > 0 Then
            opdaterbeløb lejerRæk, beløb
        Else
            MsgBox ("LejerNr.: " + CStr(lnr) + " ikke fundet")
        End If
    Wend

Jeg har blot formateret cellerne, så det er nærmest fiset....

Dog halter den lidt på linie 1

Jamens hvad skal jeg sige..... ???

Det virker ligesom jeg tænker det skal ;) topnice...... og det løser en million problemer for mig ;)

En luksusting.....kan evt. oprettes som ekstra spm.

Kan man tage alle de beløb som der ikke findes en lejer til, lægge dem sammen og til sidst udskrive dem som et beløb??

Iflg. dette: "og beløbet skal udskrives i kroner.." var antagelsen at det var hele kr - men hvis dette ikke er tilfældet - så er din tilføjelse OK - men beløbs-kolonner skal så formateres med 2 dec.

Jeps, har nemlig bare formateret hele kolonnen og det ser ud til at virke ligesom det skal ;)

Vedr. "Luksus" - den få du med i købet. - et øjeblik.....

oki....

Const importFilnavn = "import.txt"          'kan tilpasses
Dim sti, antalRæk
Dim ingenLejer As Single
Private Sub udførImport()
Rem hentsti
    sti = ActiveWorkbook.Path
    If Right(sti, 1) <> "\" Then
        sti = sti + "\"
    End If
   
    ingenLejer = 0
   
Rem antalrækker i lejeliste
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem udfør importen
    importer

Rem Test om omsamlede beløb for ukendt lejer
    If ingenLejer > 0 Then
        antalRæk = antalRæk + 1
        Cells(antalRæk, 1) = "Ukendt lejer"
        Cells(antalRæk, 4) = ingenLejer
    End If

    MsgBox ("Importen udført")
End Sub
Private Sub importer()
Dim lejenr, beløb, lejerRæk
    Open sti + importFilnavn For Input As #1
    While Not EOF(1)
        Input #1, lejenr, beløb
        lejerRæk = findLejer(lejenr)
        If lejerRæk > 0 Then
            opdaterbeløb lejerRæk, beløb
        Else
            MsgBox ("LejerNr.: " + CStr(lejenr) + " ikke fundet")
            ingenLejer = ingenLejer + beløb
        End If
    Wend
   
    Close #1
End Sub
Private Function findLejer(lnr)
Rem find lejenr i liste
    For r = 2 To antalRæk
        If Cells(r, 1) = lnr Then
            findLejer = r
            Exit Function
        End If
    Next r
    findLejer = 0
End Function
Private Sub opdaterbeløb(ræk, beløb)
    Cells(ræk, 4) = Cells(ræk, 4) + beløb / 100
End Sub

Ups.: skal også have tilføjet / 100

            ingenLejer = ingenLejer + beløb / 100

Hmm...den spørger efter et navn til denne makro..... virker ikke helt....

Hvor optræder fejlen - er der mulighed for DEBUG - hvad er meldingen??

Nu kører den...men påstår at alle lejere ikke eksisterer......og den lægger 10*300kr sammen til 300.000,-

Nu tæller den rigtigt...... men trodser at listen kontra filen indeholder de samme 10 lejer numre....

Spørgsmål: Jeg har flyttet LejeNr til kolonne A - har du også det eller???

Har du udført tilføjelsen - min kommentar 21:39:57 ???

Spørgsmål: Jeg har flyttet LejeNr til kolonne A - har du også det eller???
OK, finder ikke lejerne

Har du udført tilføjelsen - min kommentar 21:39:57 ???
Jeps, den virker nu efter hensigten

Status? - er det OK

Men den finder ikke lejerne...

Åh nej, nu kommer der en runtime error 55 når jeg forsøger at køre den, noget med file already open!

Hvilken kolonne i Lejeliste har du p.t. Lejenr?

I den sidste version forudsætter programmet, at det er kolonne A:
***
Rem find lejenr i liste
    For r = 2 To antalRæk
        If Cells(r, 1) = lnr Then <---- (r,1) 1 = A
            findLejer = r
            Exit Function
        End If
    Next r
    findLejer = 0
End Function
***

Hos mig er der ingen problemer!!

Arrghhh.... de ligger jo stadig i kol C læste lige lidt for hurtigt!!

Det tager vi lige højde for - ny version af nedenstående "Sub":

Private Sub importer()
Dim lejenr, beløb, lejerRæk
On Error GoTo lukImport

    Open sti + importFilnavn For Input As #1
    While Not EOF(1)
        Input #1, lejenr, beløb
        lejerRæk = findLejer(lejenr)
        If lejerRæk > 0 Then
            opdaterbeløb lejerRæk, beløb
        Else
            MsgBox ("LejerNr.: " + CStr(lejenr) + " ikke fundet")
            ingenLejer = ingenLejer + beløb / 100
        End If
    Wend
   
    Close #1
    Exit Sub
   
lukImport:
    Resume Next
End Sub

Skulle fungere - men tester den lige....

Ok...prøver lige at oprette nyt regneark....nu er den helt på tværs...

Testet OK

Ok.... men nu er den vist helt galt ;( Når jeg trykker play, så kommer der bare en tom boks op, har jeg trykket på noget forkert? VBA scriptet ligger der som det skal!

Hvis du sender en mail til mig: pb@supertekst-it.dk - så returnerer jeg min testfiler.

gjort

Er ikke modtaget i skrivende stund - hvis ikke der er noget i postkassen indenfor rimelig tid - så fortsætter vi i morgen.....

Det er sendt igen....

Hvordan kan det være at jeg ikke kan afvikle/køre VBA script fra min Excel nu??

?? - Prøv evt. at genstarte....

Er startet igen ved udgangspunktet....

Når den starter scriptet...kører den og udskriver og så skriver den noget Input past end of file og kører jeg den igen siger den: file already open!

De virker 100%

Smid et svar og indkasserer straks 200p

Fint - tak for dysten...

Jeg bukker og takker endnu engang ;)