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!
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
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.