Lagre tabeller

[Betong]

Jeg bruker Excel til å tegne kurver av prøveresultater.

Er det mulig å lagre verdiene i regnearket på en slik måte at de kan hentes inn i igjen senere?

 

Jeg tenker å bruke et ark som jeg skriver inn resultatene i, og lagrer verdiene til en tabell.

Etter at arket er lagret skriver jeg inn nye verdier, og lagrer på nytt.

Det kunne være fint å kunne hente inn verdiene ved å søke på prøvenr eller dato.

 

I deg lagrer jeg som PDF.

 

Er det mulig å gjøre dette i Excel, eller må det gjøres i f.eks Access?

 

Legger med regnearket som jeg bruker i dag.

 

 

 

 

 

 

Test.xlsx

Endret 23. oktober 2018 av Betong

[Harald Staff]

Hei

 

Dette er ganske små greier, så jeg foreslår å lagre en tekstfil for hver dag. Koden nedenfor Lagrer og henter for datoen som står i celle G7. Altså, når du skal hente en dag, skriv den dagen i G7 og kjør koden Hent.

Option Explicit

Const Mappe As String = "C:\Temp\" 'endre!

Sub Lagre()
Dim Dt As Date
Dim Fil As String
Dim iFnum As Integer
Dim R As Long

On Error Resume Next
Dt = Cells(7, 7).Value
If Dt < 40000 Then Exit Sub
Fil = Mappe & Format(Dt, "yyyymmdd") & ".txt"
iFnum = FreeFile
Open Fil For Output As #iFnum

Print #iFnum, "7" & vbTab & "2" & vbTab & Cells(7, 2).Value
Print #iFnum, "7" & vbTab & "7" & vbTab & Cells(7, 7).Value
Print #iFnum, "8" & vbTab & "2" & vbTab & Cells(8, 2).Value
Print #iFnum, "8" & vbTab & "7" & vbTab & Cells(7, 7).Value
Print #iFnum, "9" & vbTab & "7" & vbTab & Cells(9, 7).Value
Print #iFnum, "10" & vbTab & "3" & vbTab & Cells(10, 3).Value
Print #iFnum, "10" & vbTab & "7" & vbTab & Cells(10, 7).Value

For R = 14 To 16
    Print #iFnum, CStr(R) & vbTab & "9" & vbTab & Cells(R, 9).Value
Next

For R = 15 To 21
    Print #iFnum, CStr(R) & vbTab & "2" & vbTab & Cells(R, 2).Value
Next

Close #iFnum
DoEvents
MsgBox Fil & " er skrevet.", , "Flink fyr"
End Sub

Sub Hente()
Dim Dt As Date
Dim Fil As String
Dim iFnum As Integer
Dim R As Long, C As Long, i As Long
Dim Linje As String, Avsn() As String

On Error Resume Next
Dt = Cells(7, 7).Value
Fil = Mappe & Format(Dt, "yyyymmdd") & ".txt"
If Dir(Fil) = "" Then
    MsgBox "Vi har ikke data for " & Cells(7, 7).Value
    Exit Sub
End If

iFnum = FreeFile
Open Fil For Input As #iFnum
While Not EOF(iFnum)
    Line Input #iFnum, Linje
    Avsn = Split(Linje, vbTab)
    If UBound(Avsn) = 2 Then
        R = Val(Avsn(0))
        C = Val(Avsn(1))
        Cells(R, C).Value = Avsn(2)
    End If
Wend
Close #iFnum
End Sub

Du må endre "mappe" øverst til stedet du vil lagre.

 

Legger ved noe som virker her. Fjern .txt fra filnavnet før du begynner.

NyTest.xlsm.txt

 

Beste hilsen Harald

[Betong]

Hei,

 

Dette fungerer helt genialt, men kan du bytte om slik at prøve nummeret i celle C10 blir filnavnet?

Da kan jeg lagre flere prøver for samme dag.

 

Tusen takk for hjelpen!

[Harald Staff]

Så bra!

 

Javisst. Erstatt

Fil = Mappe & Format(Dt, "yyyymmdd") & ".txt"

med

Fil = Mappe & Cells(10, 3).Value & ".txt"

i begge makroer.

 

La meg si litt om R og C når jeg først har ordet. Det vi vanligvis ser i Excel er adresser som "G5", altså kolonne G rad 5. Men internt jobber Excel i et modus som sier" Row 5 Column 7" for denne samme adressen. Den settingen kalles R1C1, mens "vanlig" heter A1.

 

R1C1 brukes flittig i programmering av flere grunner. Så

Cells(10, 3)

betyr rad 10, kolonne 3, som er kolonne C når vi teller tre fra venstre, altså C10.

 

Beste hilsen Harald

 

Edit, ops, du skal nok også endre meldingen

MsgBox "Vi har ikke data for " & Cells(7, 7).Value

til

MsgBox "Vi har ikke data for " & Cells(10, 3).Value

Endret 26. oktober 2018 av Harald Staff

[Harald Staff]

Hei igjen

 

Etter å ha sovet på det -rart hvordan hjernen virker i søvne- her kommer en liten sak du kan trenge. Denne lager en fil Logg.txt som logger prøvenr, dato og utført av idet du lagrer. Denne må ligge i samme modulen som de to andre makroene:

Private Sub Huske()
Dim Dt As Date
Dim Fil As String
Dim iFnum As Integer

On Error Resume Next
Dt = Cells(7, 7).Value
Fil = Mappe & "Logg.txt"
iFnum = FreeFile

Open Fil For Append As #iFnum
Print #iFnum, Cells(10, 2).Value & Cells(10, 3).Value & Cells(10, 4).Value & _
    vbTab & Format(Dt, "dddd d.mmmm yyyy") & vbTab & Cells(10, 7).Value
Close #iFnum
DoEvents
End Sub

Denne implementerer du på slutten av Sub Lagre ved å legge til "Call Huske", så det ser slik ut:

Close #iFnum
DoEvents
Call Huske
MsgBox Fil & " er skrevet.", , "Flink fyr"

Beste hilsen Harald

[Betong]

Hei,

 

Dette ser veldig nyttig ut for meg.

 

Fint at du du forklarer litt om hvordan ting fungerer, morro å prøve å forandre på ting og se om / hvordan det virker.

 

Nok en gang takk for hjelpen, fin at du bruker tid på å hjelpe en som ikke kan dette her!

[Harald Staff]

Så bra.

Da har du bakgrunn nok til å rette denne pinlige feilen i Lagre:

 

Print #iFnum, "8" & vbTab & "7" & vbTab & Cells(7, 7).Value

 

Det skal selvfølgelig være (8, 7)

 

Beste hilsen Harald

[Betong]

[Betong]

Så bra.

Da har du bakgrunn nok til å rette denne pinlige feilen i Lagre:

 

Print #iFnum, "8" & vbTab & "7" & vbTab & Cells(7, 7).Value

 

Det skal selvfølgelig være (8, 7)

 

Beste hilsen Harald

 

 

 

Hallo,

Har prøvd å spille inn en makro for å lagre regnearket som en PDF fil.

Har fått det til å virke.....nesten.

Filen blir lagret i C:\Users\Acer\Documents, ikke i D:\Sikteprøver\SikkerhetskopiSikteprøver.

 

Har også prøvd å legge inn mellomrom mellom cellene som filnavnet, men får det ikke til å fungere. Har prøvd med vbTab

 

Håper du kan hjelpe meg.  

 

Mvh Stein

Sub Lagre_som_PDF()
'
' Lagre_som_PDF Makro
'

'
    ChDir "D:\Sikteprøver\SikkerhetskopiSikteprøver"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cells(10, 2).Value & Cells(10, 3).Value & Cells(10, 4).Value & Cells(9, 2).Value & Cells(7, 2).Value & Cells(8, 2).Value & Cells(7, 7), Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
End Sub

[Harald Staff]

Hei igjen Stein

 

ChDir hjelper deg lite. Løsningen ligger etter Filename:=. Der skal stå full gyldig filbane med stasjonsnavn og \ og .pdf og greier. Sjekk hva alle de nevnte cellene resulterer i.

 

Beste hilsen Harald

[Betong]

Hei igjen Stein

 

ChDir hjelper deg lite. Løsningen ligger etter Filename:=. Der skal stå full gyldig filbane med stasjonsnavn og \ og .pdf og greier. Sjekk hva alle de nevnte cellene resulterer i.

 

Beste hilsen Harald