Avatar billede Slettet bruger
09. november 2012 - 23:09 Der er 4 kommentarer og
1 løsning

excel henter data fra .txt

Hej eksperter!

Jeg tænkte på om man kunne få en VBA kode til af hente data fra en .txt fil til excel?

.txt filen hedder noget forskelligt hver gang.
Excel filen og .txt filen ligger i samme mappe. hvis den gør det. så skal vba koden kunne gå ind og hente data i .txt og udfylde / erstatte det i excel.

I excel filen er der et sheet der hedder database.
A1 står der 1.
A2 står der 2.
A3 står der 3.
osv. (Op til 1000 - skal kunne udvides hvis det er nødvendigt)

det der står i .txt filen skal placeres i.
B1
B2
B3
osv. (Op til 1000 - skal kunne udvides hvis det er nødvendigt)

Er det muligt?
tak på forhånd igen!
Avatar billede Slettet bruger
12. november 2012 - 21:01 #1
Ingen :)?
Avatar billede Slettet bruger
14. november 2012 - 16:31 #2
Der må være en der kan hjælpe :)?!
Avatar billede Slettet bruger
16. november 2012 - 00:18 #3
Har fundet en kode jeg kunne gå ud fra.
Problmet er, at jeg skal indtaste sti for .txt filen.
Kunne godt tænke mig af hvis der bare lå en .txt fil i mappen med excel. af så kunne excel/vba finde .txt filen.

VBA koden:

Sub ImportDelimitedText()
'Importerer teksten adskilt af sSepChar i sSourceFile til
'Range(sTargetAddress). Overskriver ældre data.
'Normalt vil denne procedure blive kaldt af en anden,
'som så samtidig videregiver info om tekstfilens navn
'og sti (sSourceFile), separatortegn (sSepChar) og evt.
'celleadressen (sTargetSddress), hvor teksten skal sættes ind.

Dim sDel As String * 1
Dim LineString As String
Dim sSourceFile As String
Dim sSepChar As String
Dim sTargetAddress As String
Dim rTargetCell As Range
Dim vTargetValues As Variant
Dim r As Long
Dim fLen As Long
Dim fn As Integer

On Error GoTo ErrorHandle

'Importfilen og dens placering
sSourceFile = "C:\Stien Til Filen"
'Separatortegn (delimiter)
sSepChar = ";"
'Startcelle for placering af data
sTargetAddress = "A1"

'sSourceFile eksisterer ikke
If Len(Dir(sSourceFile)) = 0 Then Exit Sub

'Identificerer delimiter
If UCase(sSepChar) = "TAB" Or UCase(sSepChar) = "T" Then
  sDel = Chr(9)
Else
  sDel = Left(sSepChar, 1)
End If

'Importér data
Worksheets(1).Activate

'Sætter startcellens adresse
Set rTargetCell = Range(sTargetAddress).Cells(1, 1)

'Sletter evt. gamle data
rTargetCell.CurrentRegion.Clear '<--------------------------------------- DETTE SKAL SLETTES VED BRUG!!!!!!!!!!!!!!!!!!!!!!!!!!!

On Error GoTo BeforeExit

'Får et frit nummer af operativsystemet
fn = FreeFile

'Åbner filen for input
Open sSourceFile For Input As #fn
On Error GoTo 0
fLen = LOF(fn)
r = 0
While Not EOF(fn)
  Line Input #fn, LineString
  'Kalder funktionen, som skal læse teksten.
  vTargetValues = ParseDelimitedString(LineString, sSepChar)
  'Skriver til celler
  UpdateCells rTargetCell.Offset(r, 0), vTargetValues
  r = r + 1
Wend

'Lukker tekstfilen
Close #fn

BeforeExit: 'Rydder op
Set rTargetCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i ImportDelimitedText."
Resume BeforeExit
End Sub

Function ParseDelimitedString(InputString As String, _
sDel As String) As Variant
'Returnerer et variant array indeholdende hvert element
'i InputString adskilt af sDel.

Dim i As Integer, iCount As Integer
Dim sString As String, sChar As String * 1
Dim ResultArray() As Variant

On Error GoTo ErrorHandle

sString = ""
iCount = 0
For i = 1 To Len(InputString)
  sChar = Mid$(InputString, i, 1)
  If sChar = sDel Then
    iCount = iCount + 1
    ReDim Preserve ResultArray(1 To iCount)
    ResultArray(iCount) = sString
    sString = ""
  Else
    sString = sString & sChar
  End If
Next i
iCount = iCount + 1
ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
ParseDelimitedString = ResultArray

Exit Function
ErrorHandle:
MsgBox Err.Description & " Fejl i funktionen ParseDelimitedString."
End Function

Sub UpdateCells(rTargetRange As Range, vTargetValues As Variant)
'Skriver indholdet i variablen vTargetValues
'til det aktive faneblad begyndende i rTargetRange.
'Eksisterende data overskrives.

Dim r As Long, c As Integer

On Error GoTo ErrorHandle

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
r = 1
c = 1

On Error Resume Next

c = UBound(vTargetValues, 1)
r = UBound(vTargetValues, 2)
Range(rTargetRange.Cells(1, 1), rTargetRange.Cells(1, 1). _
Offset(r - 1, c - 1)).Formula = vTargetValues

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i UpdateCells."
End Sub
Avatar billede Slettet bruger
18. november 2012 - 19:56 #4
Ingen der kan hjælpe? forhøjer med 40 point.

fks. det jeg søger er af jeg har en txt fil.
Den kan hedder fks. test v. 1.1.1.txt vba koden skal kunne finde den nyeste. jo højere tallet er, jo nyere er filen.
Samt af denne test v. 1.1.1.txt ligger altid i samme mappe som excel filen. men mappen kan stadig ligge på en server, eller på skrivebordet, eller andet sted.
Avatar billede Slettet bruger
19. november 2012 - 22:55 #5
Lukker.
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
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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