Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

Kopiowanie zawartości plików dat do excela

ImportDattoExcel

  • Please log in to reply
15 replies to this topic

#1 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 23 październik 2017 - 09:34

Witajcie, chciałbym stworzyć makro, które eksportuje wartości z plików dat do excela.
Liczba plików jest ogromna ( rzędu kilku tysięcy).
Docelowo chce linijkę pliku dat eksportować do komórki w Excelu, i nastepnie każdą następna linijkę z dat do następnej kolumny tego samego wiersza w excelu.
 

Problem mam z zapętleniem ścieżki dostępu do plików importowanych ( aktualnie mam ścieżkę dla innego pliku i nie potrafie tego zapętlić)

 

 

pliki nazywają się: LV-U01-T_ST1_LV-U01-T cz.2_203_523.1001562_CP_2017-09-01.DAT,

LV-U01-T_ST1_LV-U01-T cz.2_203_523.1001562_CP_2017-09-02.DAT   itp..

 

Kolejny plik dat na zostac importowany do drugiego wiersza, następny do trzeciego itd.

 

mój aktualny kod makra jest następujący:

 

Sub Importowanie()

Dim Plik As String


Plik = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\LV-U01-T_ST1_LV-U01-T cz.2_203_523.1001562_CP_2017-09-01.DAT"

Open Plik For Input As #1
numerKolumny = 1

Do Until EOF(1)   'pętla dopóki EOF - End Of File '

    Line Input #1, LineFromFile   
    
    Cells(1, numerKolumny).Value = LineFromFile
    
    numerKolumny = numerKolumny + 1

Loop
Close #1

End Sub
 



#2 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 23 październik 2017 - 11:24

Pliki są w tym samym katalogu?

Ile jest wierszy w poszczególnym pliku?

 

---
edit: na szybko (ustaw swój katalog z plikami).

FYI: kod będzie próbował otwierać każdy plik ".dat" w podanym katalogu.

 

Option Explicit

Sub Importowanie()

Dim SourceFolderName As String, FileItemName As String, LineFromFile As String
Dim SourceFolder As Object, fso As Object, FileItem As Object
Dim numerKolumny As Integer, wiersz As Integer
Dim t As Double, t1 As Double, odp As Variant

On Error Resume Next

t1 = Now()

SourceFolderName = "C:\1"
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)

wiersz = 1

For Each FileItem In SourceFolder.Files
    FileItemName = SourceFolderName & "\" & FileItem.Name
    If Right(FileItemName, 4) = ".dat" Then
        Open FileItemName For Input As #1
        numerKolumny = 1

        Do Until EOF(1)   'pętla dopóki EOF - End Of File '
            Line Input #1, LineFromFile
            Cells(wiersz, numerKolumny).Value = LineFromFile
            numerKolumny = numerKolumny + 1
        Loop
        Close #1
        wiersz = wiersz + 1
    End If
Next

t = Now() - t1
odp = MsgBox("Wykonano. Czas: " & Format(t, "h:mm:ss"), vbInformation, "Info")

End Sub


Uwaga1: program czyta pliki w kolejności alfabetycznej - pliki nazwane "1", "2", "3", ..., "200" w eksploratorze zobaczysz w takiej właśnie kolejności a program będzie czytał w kolejności: "1", "10", "100", "101"...



#3 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 23 październik 2017 - 11:27

w każdym pliku jest 30 wierszy.
Makro zadziałało, czas 17 sekund - nice :D
w jaki sposób zmieniać katalogi, aby pobierać dane z plików z różnych katalogów?



#4 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 23 październik 2017 - 11:38

Do wyboru: może być jako okno dialogowe albo jako parametr wpisywany "z palca".

 

Wersja 1:

 

Option Explicit

Sub Importowanie()

Dim SourceFolderName As String, FileItemName As String, LineFromFile As String
Dim SourceFolder As Object, fso As Object, FileItem As Object
Dim numerKolumny As Integer, wiersz As Integer
Dim t As Double, t1 As Double, odp As Variant

On Error Resume Next

SourceFolderName = GetFolder
If SourceFolderName = "" Then
    odp = MsgBox("Nie wybrano katalogu", vbCritical, "Błąd")
    Exit Sub
End If

t1 = Now()

Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(SourceFolderName)

wiersz = 1

For Each FileItem In SourceFolder.Files
    FileItemName = SourceFolderName & "\" & FileItem.Name
    If Right(FileItemName, 4) = ".dat" Then
        Open FileItemName For Input As #1
        numerKolumny = 1

        Do Until EOF(1)   'pętla dopóki EOF - End Of File '
            Line Input #1, LineFromFile
            Cells(wiersz, numerKolumny).Value = LineFromFile
            numerKolumny = numerKolumny + 1
        Loop
        Close #1
        wiersz = wiersz + 1
    End If
Next

t = Now() - t1
odp = MsgBox("Wykonano." & vbCrLf & "Czas: " & Format(t, "h:mm:ss") & vbCrLf & _
"Plików: " & wiersz - 1, vbInformation, "Info")

Set fso = Nothing
Set SourceFolder = Nothing
End Sub

Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
 
sItem = ""
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Wybierz katalaog z plikami do importu"
    .AllowMultiSelect = False
    .InitialFileName = CurDir 'Application.DefaultFilePath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With

NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function


#5 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 23 październik 2017 - 13:56

Ok, a jeśli chce użyć kilku katalogów z których chce wyciągnać pliki dat?
Jak stworzyć tablice dostępów do tych katalogów? Zeby oczywiście nie powtarzać kodów makra dla każdego oddzielnego katalogu



#6 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 23 październik 2017 - 14:10

Można te katalogi zapisać tymczasowo w Arkuszu2?



#7 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 23 październik 2017 - 15:12

Można te katalogi zapisać tymczasowo w Arkuszu2?

Chyba się nie rozumiemy.
Chodzi mi o to żeby pobierać wartości z plików z różnych katalogów.
Chce stworzyć tablice która zawiera te katalogi, żeby nie powtarzać większości makra -> żeby działało szybciej.
W jaki sposób to zrobić??



Dobra- udało mi się:)

Mój cały kod jeśli ktoś byłby ciekaw:
 

Sub Importowanie1()

Dim SourceFolderName As String, FileItemName As String, LineFromFile As String
Dim SourceFolder As Object, fso As Object, FileItem As Object
Dim numerKolumny As Integer, wiersz As Integer
Dim t As Double, t1 As Double, odp As Variant
Dim Dostep(1 To 4) As String
Dim i As Byte

        Dostep(1) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra"
        Dostep(2) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\plik1"
        Dostep(3) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\Plik2"
        Dostep(4) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\Plik3"
        
t1 = Now()

For i = 1 To 4

    SourceFolderName = Dostep(i)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = fso.GetFolder(SourceFolderName)

    wiersz = Application.WorksheetFunction.CountA(Range("A:A")) + 1

    For Each FileItem In SourceFolder.Files
     FileItemName = SourceFolderName & "\" & FileItem.Name
     Open FileItemName For Input As #1
     numerKolumny = 1

     Do Until EOF(1)
           Line Input #1, LineFromFile
          Cells(wiersz, numerKolumny).Value = LineFromFile
          numerKolumny = numerKolumny + 1
        Loop
        Close #1
        wiersz = wiersz + 1
    Next
Next

t = Now() - t1
odp = MsgBox("Wykonano. Czas: " & Format(t, "h:mm:ss"), vbInformation, "Info")

End Sub

 



#8 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 23 październik 2017 - 20:11

Też to zrobiłem tylko trochę inaczej. Moje pytanie było: czy zapamiętasz wybierane katalogi czy może lepiej je tymczasowo gdzieś zapisywać (żeby nie zdublować ani nie pominąć)?

 

Bez zapisywania:

 

 

Option Explicit

Sub Importowanie()

Dim SourceFolderName As String, FileItemName As String, LineFromFile As String
Dim SourceFolder As Object, fso As Object, FileItem As Object
Dim numerKolumny As Integer, wiersz As Integer
Dim t As Double, t1 As Double, odp As Variant
Dim FolderList() As String, i As Integer, j As Integer

On Error Resume Next

i = 0

Do
    SourceFolderName = GetFolder
    If SourceFolderName = "" Then
        Exit Do
    Else
        i = i + 1
        ReDim Preserve FolderList(i)
        FolderList(i) = SourceFolderName
    End If
Loop

t1 = Now()

Set fso = CreateObject("Scripting.FileSystemObject")
wiersz = 1

For j = 1 To i
    SourceFolderName = FolderList(j)
    Set SourceFolder = fso.GetFolder(SourceFolderName)
    
    For Each FileItem In SourceFolder.Files
        FileItemName = SourceFolderName & "\" & FileItem.Name
        If Right(FileItemName, 4) = ".dat" Then
            Open FileItemName For Input As #1
            numerKolumny = 1
    
            Do Until EOF(1)   'pętla dopóki EOF - End Of File '
                Line Input #1, LineFromFile
                Cells(wiersz, numerKolumny).Value = LineFromFile
                numerKolumny = numerKolumny + 1
            Loop
            Close #1
            wiersz = wiersz + 1
        End If
    Next
Next j

t = Now() - t1
odp = MsgBox("Wykonano." & vbCrLf & "Czas: " & Format(t, "h:mm:ss") & vbCrLf & _
"Katalogów: " & j - 1 & ", Plików: " & wiersz - 1, vbInformation, "Info")

Set fso = Nothing
Set SourceFolder = Nothing
End Sub

Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
 
sItem = ""
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Wybierz katalaog z plikami do importu"
    .AllowMultiSelect = False
    .InitialFileName = CurDir 'Application.DefaultFilePath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With

NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Cancel/Anuluj oznacza koniec wybierania i przejście do kopiowania.



Tu masz fragment zmodyfikowany pod kątem kontroli duplikatów katalogów:

 


Do
    SourceFolderName = GetFolder
    If SourceFolderName = "" Then
        Exit Do
    Else
        If i > 0 Then
            For j = 1 To i              'dla kolejnych
                If SourceFolderName = FolderList(j) Then    'jeśli już taki jest
                    odp = MsgBox("Taki folder już jest na liście. Dodać mimo to?", _
                    vbYesNo, "Uwaga")
                    If odp = vbYes Then     'jeśli dodać
                        i = i + 1
                        ReDim Preserve FolderList(i)
                        FolderList(i) = SourceFolderName
                        GoTo la1
                    Else
                        GoTo la1
                    End If
                Else                        'jeśli nie ma
                    i = i + 1
                    ReDim Preserve FolderList(i)
                    FolderList(i) = SourceFolderName
                    GoTo la1
                End If
            Next j
        Else                            'przypadek dla 1-szej pozycji w tablicy
            i = i + 1
            ReDim Preserve FolderList(i)
            FolderList(i) = SourceFolderName
        End If
    End If
la1:
Loop
 

 


 



#9 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 24 październik 2017 - 08:01

Dobra, wczorajszy problem został rozwiązany, teraz mam lekko inny temat.

Tym razem chce połączyć wybrane wiersze wielu plików excelowych, w jeden plik excelowy.
Warunkiem wyboru wierszy jest to że znajdują się pod komórką zawierającą daną wartość.
 

Chce zmodernizować mój kod, który Ci wczoraj przedstawiłem.
 



#10 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 24 październik 2017 - 10:03

Daj jakiś przykład (najlepiej kilka plików).



#11 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 24 październik 2017 - 12:07

Daj jakiś przykład (najlepiej kilka plików).


Tego rodzaju pliki mam wgrywać.
Każdy ma taka samą formę.
Chce zrobić to na dwojaki sposób:
1. Chce skopiować wiersze pod wartością PPE w komórce A3
2. Chce skopiować 7 pierwszych  wierszy z każdego pliku
do jednego pliku zbiorczego

Załączone pliki



#12 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 24 październik 2017 - 13:08

Nie do końca rozumiem. To co dałeś to jeden z plików do kopiowania (tzn. zawartość)?

 

Czyli w przypadku 1 ma to wyglądać tak: https://www.sendspace.com/file/j9me8f

a w przypadku 2 tak: https://www.sendspace.com/file/e49qns ?

 

A lokalizacja plików?



#13 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 24 październik 2017 - 13:14

Nie do końca rozumiem. To co dałeś to jeden z plików do kopiowania (tzn. zawartość)?

 

Czyli w przypadku 1 ma to wyglądać tak: https://www.sendspace.com/file/j9me8f

a w przypadku 2 tak: https://www.sendspace.com/file/e49qns ?

 

A lokalizacja plików?

Tak, ten plik który dałem to dane do skopiowania.

Dokładnie tak to ma wygladać.
Tylko w przypadku pliku 2: nie potrzebne są te wartości(-1, -2 itp.)

Możesz podać kod makra?
 

 

Odnośnie lokalizacji plików, przed użyciem makra wpisuje je do tablicy, z których ma te lokalizacje pobierać.



#14 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 24 październik 2017 - 13:44

Jak napiszę  to podam (pliki zrobiłem ręcznie)  ;) .

 

---

edit:

Dane:

Dostep(2) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\plik1"
Dostep(3) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\Plik2"
Dostep(4) = "T:\TECHNICZNY\backup\01.DO ZROBIENIA\Grzegorz\dane do makra\Plik3"

mają być zaszyte w kodzie czy zrobić jakiś plik ".ini"?



#15 GreG321

GreG321

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 24 październik 2017 - 17:05

Nie kombinujmy z .ini - chce te makro chociaż troche rozumieć :P

 

To są foldery w których są pliki excelowe.


Mają być za każdym razem wpisywane do makra przed odpaleniem- te foldery będą się zmieniać za każdym razem.



#16 broda99

broda99

    Rozmowny

  • Forumowicze
  • PipPipPipPipPipPip
  • 561 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:W-wa

Napisany 24 październik 2017 - 23:47

te foldery będą się zmieniać za każdym razem.

Właśnie o to mi chodzi - za każdym razem będziesz ingerował w kod?

Nie lepiej to jakoś zrobić z automatu? Tylko  jak? (jakaś reguła / prawidłowość / cokolwiek...).

 

 

Tak czy siak: Priv.






0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników