09. november 2012 - 23:09Der 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)
Når salg, marketing og service kun ser dele af kundebilledet, risikerer virksomheden at miste overblik og kunder. AI kan forstærke problemet.
Slettet bruger
12. november 2012 - 21:01#1
Ingen :)?
Synes godt om
Slettet bruger
14. november 2012 - 16:31#2
Der må være en der kan hjælpe :)?!
Synes godt om
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
Synes godt om
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.
Synes godt om
Slettet bruger
19. november 2012 - 22:55#5
Lukker.
Synes godt om
Ny brugerNybegynder
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.