Elektroda.pl
Elektroda.pl
X
Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

Macro VBA - Excel zmienia pli tylko do odczytu

Jean1990 26 Jan 2015 06:50 2193 23
  • #1
    Jean1990
    Level 8  
    Witam,
    napisane w excelu makro otwiera nowy plik jako "tylko do odczytu", aby następnie wyszukać w nim dane i skopiować je. Problem polega na tym, że Excel zmienia jednocześnie strukturę pliku, który otwiera. Plik w formacie *.csv rozdziela kolumny, zmienia format komórek(z tekstu na datę), a co za tym idzie, uniemożliwia schematyczne szukanie po wierszach. Jaka może być tego przyczyna?

    Z góry dziękuję za pomoc i pozdrawiam,
    Jean
  • #2
    jdubowski
    Tube devices specialist
    Jean1990 wrote:
    napisane w excelu makro otwiera nowy plik jako "tylko do odczytu", aby następnie wyszukać w nim dane i skopiować je. Problem polega na tym, że Excel zmienia jednocześnie strukturę pliku, który otwiera.


    Ustaw na poziomie systemu atrybut "tylko do odczytu" by się zabezpieczyć przed zmianą pliku przy obróbce.

    Jean1990 wrote:
    Plik w formacie *.csv rozdziela kolumny, zmienia format komórek(z tekstu na datę)


    Coś nie za bardzo rozumiem - plik *.CSV nie ma przecież formatowania komórek - może idzie o to że interpretuje po prostu zawarty w pliku tekst jako datę?
  • #3
    Jean1990
    Level 8  
    Plik ustawiam jako tylko do odczytu, bo o to mi chodzi i jest to intencjonalne.

    Sam plik .csv otwieram bez pomocy makra w excelu i widzę określoną strukturę. Niestety, kiedy plik jest otwierany przez makro, struktura się zmienia. Może by mi to nie przeszkadzało tak bardzo, gdyby nie zmieniał jednocześnie w konkretnej kolumnie formatowania komórki z tesktu na datę...

    Dodano po 4 [minuty]:

    Chodzi mi o to, że w otwartym przez makro pliku pewna kolumna ma komórki określone jako "data", co przeszkadza, czy wyszukiwaniu fragmentu tekstu. No chyba, że jest jakaś możliwość wyszukiwania przez makro konkretnej daty, bo o tym niestety nic mi nie wiadomo.
  • #4
    PRL
    Level 40  
    Może pokaż makro i załącz wycinek csv.
  • #5
    Jean1990
    Level 8  
    Code:
    Sub Makro2()
    

    'Definiowanie zmiennych
    Dim DataStart, DataStop As String
    Dim RokStart, MiesiacStart, DzienStart, GodzinaStart, MinutyStart, OdJedynki As String
    Dim RokStop, MiesiacStop, DzienStop, GodzinaStop, MinutyStop As String
    Dim Kat, Sciezka, PelnaSciezka, poczatek, koniec As String
    Dim i, wStart, wStop, wZakres, ileStart, ileStop, adresStart, adresStop, ile, k, n, m As Integer
    Dim wb As Workbook
    Dim GCell As Range
    Dim ws As Worksheet
    Dim data As Date


    'Ustalanie wartości zmiennych


    Kat = Range("D2").Value
    i = 0
    w = 1
    Sciezka = ThisWorkbook.Path & "\" & Kat & "\" & Kat & "_H" & i & ".csv"
    PelnaSciezka = ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P"

    RokStart = Range("D4").Value
    MiesiacStart = Range("E4").Value
    DzienStart = Range("F4").Value
    GodzinaStart = Range("G4").Value
    MinutyStart = Range("I4").Value

    RokStop = Range("D6").Value
    MiesiacStop = Range("E6").Value
    DzienStop = Range("F6").Value
    GodzinaStop = Range("G6").Value
    MinutyStop = Range("I6").Value

    wZakres = wStart - wStop
    adresStart = Range("A2").Value
    adresStop = Range("B2").Value

    Range("A11").Value = Sciezka

    DataStart = RokStart & "-" & MiesiacStart & "-" & DzienStart & " " & GodzinaStart & ":" & MinutyStart
    DataStop = RokStop & "-" & MiesiacStop & "-" & DzienStop & " " & GodzinaStop & ":" & MinutyStop


    With ThisWorkbook.Worksheets("Arkusz1").Range("A1:B2")
        .ClearContents
    End With

    With ThisWorkbook.Worksheets("Arkusz3").Cells
        .ClearContents
    End With

    Do
        If Dir(Sciezka) = "" Then
            MsgBox "Nie odnaleziono danych dotyczących zadanego przedziału czasu"
            Exit Sub
        End If

        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "_H" & i & ".csv", True, True)
         
        With wb.Worksheets("Arkusz1").Range("a1:a1440")
            Set GCell = .Find(DataStart, LookAt:=xlPart)
            If Not GCell Is Nothing Then
                With ThisWorkbook.Sheets("Arkusz1").Range("A1")
                    .Value = GCell.Row
                    .Offset(1, 0) = i
                    wb.Close False
                    Set wb = Nothing
                    Application.ScreenUpdating = True
                    Exit Do
                End With
            End If
        End With
           
            wb.Close False
            Set wb = Nothing
            Application.ScreenUpdating = True
        w = i
        i = w + 1
    Loop Until Range("A2").Value <> ""

    Do
        If Dir(Sciezka) = "" Then
           MsgBox "Nie odnaleziono danych dotyczących zadanego przedziału czasu"
            Exit Sub
        End If

        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "_H" & i & ".csv", True, True)
         
        With wb.Worksheets("Arkusz1").Range("a1:a1440")
            Set GCell = .Find(DataStop, LookAt:=xlPart)
            If Not GCell Is Nothing Then
                With ThisWorkbook.Sheets("Arkusz1").Range("B1")
                    .Value = GCell.Row
                    .Offset(1, 0) = i
                    wb.Close False
                    Set wb = Nothing
                    Application.ScreenUpdating = True
                    Exit Do
                End With
            End If
        End With
           
            wb.Close False
            Set wb = Nothing
            Application.ScreenUpdating = True
        w = i
        i = w + 1
    Loop Until Range("B2").Value <> ""

    'Kopiowanie danych do wykresu
       Application.ScreenUpdating = False
         adresStart = Range("A2").Value
         wStart = Range("A1").Value
         wStop = Range("B1").Value
         adresStop = Range("B2").Value
    If ThisWorkbook.Worksheets("Arkusz1").Range("B2") = ThisWorkbook.Worksheets("Arkusz1").Range("A2") Then
    'hello world
           
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & adresStart & ".xls", True, True)
        With ThisWorkbook.Sheets("Arkusz3")
            wZakres = wStop - wStart + 1
            poczatek = "A1:B" & wZakres
            koniec = "A" & wStart & ":B" & wStop
            .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
        End With
            wb.Close False
    Else
        If ThisWorkbook.Worksheets("Arkusz1").Range("B2") - 1 = ThisWorkbook.Worksheets("Arkusz1").Range("A2") Then
           
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & adresStart & ".xls", True, True)
            wZakres = 1440 - wStart + 1
           
             With ThisWorkbook.Sheets("Arkusz3")
             poczatek = "A1:B" & wZakres
             koniec = "A" & wStart & ":B1440"
                .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
             End With
             wb.Close False
            ile = wZakres + 1
            wZakres = ile + wStop - 1
           
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & adresStop & ".xls", True, True)
            With ThisWorkbook.Sheets("Arkusz3")
            poczatek = "A" & ile & ":B" & wZakres
            koniec = "A1:B" & wStop
                .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
            End With
            wb.Close False
        Else
             
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & adresStart & ".xls", True, True)
             wZakres = 1440 - wStart + 1
             With ThisWorkbook.Sheets("Arkusz3")
             poczatek = "A1:B" & wZakres
             koniec = "A" & wStart & ":B1440"
                .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
             End With
             wb.Close False
           
           k = adresStart + 1
               
             Do
              Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & k & ".xls", True, True)
                With ThisWorkbook.Sheets("Arkusz3")
                    m = .Cells(.Rows.Count, "A").End(xlUp).Row
                End With
                n = m + 1
                wZakres = n + 1439
                With ThisWorkbook.Sheets("Arkusz3")
                    poczatek = "A" & n & ":B" & wZakres
                    koniec = "A1:B1440"
                    .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
                End With
                wb.Close False
                k = k + 1
             Loop Until k = adresStop
         
           
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Kat & "\" & Kat & "-P" & adresStop & ".xls", True, True)
                With ThisWorkbook.Sheets("Arkusz3")
                    m = .Cells(.Rows.Count, "A").End(xlUp).Row
                End With
                n = m + 1
                wZakres = n + wStop - 1
                With ThisWorkbook.Sheets("Arkusz3")
                poczatek = "A" & n & ":B" & wZakres
                koniec = "A1:B" & wStop
                    .Range(poczatek).Formula = wb.Sheets("Arkusz1").Range(koniec).Formula
                End With
            wb.Close False
        End If
     End If
         Application.ScreenUpdating = True
         
         OdJedynki = "A1:B" & wZakres
         Charts.Add
        ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
        ActiveChart.SetSourceData Source:=ThisWorkbook.Sheets("Arkusz3"). _
            Range(OdJedynki), PlotBy:=xlColumns
        ActiveChart.Location where:=xlLocationAsObject, Name:="Arkusz1"
        With ActiveChart
            .HasTitle = False
            .Axes(xlCategory, xlPrimary).HasTitle = False
            .Axes(xlValue, xlPrimary).HasTitle = False
        End With
        ActiveChart.HasLegend = False
       
       
    End Sub


    plik otwarty z pulpitu:
    A2 = $RT_OFF$;"2014-12-23 11:36:15";0;2;41996483506 b2 = 4352
    A3 = $RT_OFF$;"2014-12-23 11:42:27";0;2;41996487809 b3 = 2824

    plik otwarty przez makro:
    A2 = $RT_OFF$ b2=2014-12-23 11:36 c2= 0 d2 = 2 e2= 41996483506,4352
    A3 = $RT_OFF$ b3= 2014-12-23 11:42 c3=0 d3 = 2 e3= 41996487809,2824


    przepraszam, ale nie wiem jak wrzucić screenshota
  • #6
    PRL
    Level 40  
    Spróbuj zmienić w ustawieniach regionalnych separator listy na przecinek i sprawdź, jak bedzie działać.

    Link
  • #7
    Jean1990
    Level 8  
    Separator jest ustawiony na przecinek. Doszedłem do wniosku, że forma w jakiej makro otwiera ten plik jest całkiem korzystna, jeżeli tylko udałoby mi się znaleźć sposób na wyszukiwanie przez .find wśród dat. Próbowałem podstawić zmienną definiowaną jako "date" i do końca nie wiem, czy to działa, czy nie. W komórce wyświetla mi się co prawda "rrrr-mm-dd 02:08", ale wartość komórki to "rrrr-mm-dd 02:08:00" (co odpowiada wartości mojej zmiennej). W przeszukiwanym pliku są wartości pomiarów z różnej części minuty, czyli np "rrrr-mm-dd 02:08:33", więc musiałbym uwzględnić datę bez sekund, ale nie wiem jak to zrobić. Jeżeli za zmienną podstawię tekst a nie datę - wynik będzie ten sam, ponieważ data jest zakodowana jako ciąg znaków. Jakiś pomysł?

    Dodano po 52 [minuty]:

    niestety, błąd kodu... nie pasują mu te hashtagi...[/tr]
  • #8
    PRL
    Level 40  
    Code: vb
    Log in, to see the code


    Dopasuj do swojego kodu - działa.
  • #9
    Jean1990
    Level 8  
    Wartość zmiennej nadal zawiera sekundy, ale nie wyświetlają się one w komórce. Gdybyś zmieniła sekundy w przeszukiwanych komórkach np z 00 na 01, prawdopodobnie nie excel nie znalazłby daty. CDate zamienia string na date, wartość daty jednak automatycznie wypełnia puste pola tablicy(tu sekundy) zerami. Jeżeli klikniesz na komórkę i spojrzysz na formułę zobaczysz, że wartość uwzględnia sekundy.

    Dodano po 3 [minuty]:

    Trochę otchłani internetu przescautowałem, wydaje mi się, że prostszym rozwiązaniem byłoby jednak zdiagnozowanie przyczyny dla której excel zmienia formatowanie pliku, ponieważ wyszukiwanie po ciągu znaków jest rzeczą prostą;)
  • #10
    PRL
    Level 40  
    Kapuje, spróbuję coś wymyślić.
    Nie zauważyłem, że w csv masz sekundy...
  • #11
    Jean1990
    Level 8  
    Te sekundy nie mają znaczenia, pomiar był nie częstszy niż raz na minutę. Problem polega na tym, że można potraktować szukaną frazę jak część komórki, nie całość, tylko że nie wiem jak szukać tylko części wyrażenie typu date nie zmieniając jednocześnie jego formatu.

    Dodano po 3 [minuty]:

    A przy zmianie formatu na tekst niemożliwe jest wyszukiwanie wśród wyrażeń w formacie date. Dlatego myślę, że rozwiązaniem byłoby użycie pierwotnej formy pliku, przed zmianą przez macro, gdzie data jest fragmentem linii, który można bezproblemowo wyszukać. Macro niestety otwierając plik rozdziela tekst na kolumny. Jedną z nich jest wyrażenie, które excel interpretuje jako datę i automatycznie zmienia format całej kolumny uniemożliwiając wyszukanie tekstu.
  • #12
    PRL
    Level 40  
    Nie przeszkadzałoby Ci zrezygnować z Find, operować na pliku tekstowym?
    Jakoś nic innego z Find nie przychodzi mi do głowy. Excel tak po prostu ma.
    Może prościej będzie Open For Input, a potem InStr.
  • #13
    Jean1990
    Level 8  
    Nie operowałem na plikach w ten sposób do tej pory, ale może faktycznie byłoby prościej. Jedyne co, to musiałbym to doprowadzić do takiej postaci, aby do mojego arkusza przekopiować daty od początkowej do końcowej a w następnej kolumnie odpowiadające im wartości. Potrzebuję tego do wykonania wykresu, który jest tak naprawdę tym, o co chodzi mi w tym makro.
    Jeżeli masz doświadczenie w importowaniu danych w ten sposób, byłbym wdzięczny za wskazówki;)
  • #14
    PRL
    Level 40  
    Dla przykładu:

    Code: vb
    Log in, to see the code
  • #15
    Jean1990
    Level 8  
    Jeżeli dobrze zrozumiałem to wyszuka datę i zwróci prawdę, w arkuszu jednak daje mi to możliwość odczytania numeru wiersza, w którym data się znajduje, przez co mogę skopiować dane od tego wiersza aż do daty końcowej. Jeżeli dobrze rozumiem, w pliku tekstowym nie mam za bardzo takiej możliwości, ponieważ po prostu wiersze nie mają numerów(a może mają?), co utrudniałoby strasznie(lub nawet uniemożliwiało) dalsze procesy.

    Jeżeli źle zrozumiałem, przepraszam. Cały ten program jest moim pierwszym poważniejszym podejściem do operacji na makrach.

    Dodano po 5 [minuty]:

    Po dalszej analizie - sposób ten byłby o tyle trudniejszy, że wiersze mają różne długości (ilości znaków), przez co niemożliwe staje się zapisanie na stałe współrzędnych xowych w których znajdują się potrzebne dane. Przypuszczam, że gdyby program miał interpretować każdy wiersz z osobna, odczytanie danych dla okresu długości kilku dni trwałoby niesamowicie długo.
  • #16
    PRL
    Level 40  
    A co chcesz i na jakiej zasadzie przenieść z csv do Excela?
  • #17
    Jean1990
    Level 8  
    Otwierając csv przy pomocy excela program interpretuje w plik w jakiś zadany sposób. Nie wiem tylko, czemu interpretuje go inaczej kiedy komendę otwierania wydaje makro.

    Potrzebuję przenieść czas i wartość pomiaru w danym czasie w przedziałach zadanych przez użytkownika. Pomiar co minutę d przedziale x-y. Wszystko to ma służyć stworzeniu wykresu zależności parametru od czasu.
  • #18
    PRL
    Level 40  
    Jeżeli dobrze zrozumiałem, to takie makro:

    Code: vb
    Log in, to see the code


    Jest jeden błąd, ale może sam znajdziesz.;)
  • #19
    Jean1990
    Level 8  
    Początek i koniec nie muszą się znajdować w jednym pliku, ale z tym bym sobie już poradził. Nie rozumiem tylko w jaki sposób to działa;( pozostaje mi spróbować. O co chodzi ze "split" i czym jest "f"?
  • #20
    PRL
    Level 40  
    Rozpakuj te pliki na C: i sprawdź działanie.

    'f', to flaga sprawdzająca, czy w pliku wejsciowym znaleziono datę pocztątkową.
    Split() dzieli linie z pliku tekstowego csv na nazwijmy to, w rozumieniu Excela, kolumny.
  • #21
    Jean1990
    Level 8  
    Wyrzuca mi "file already open"

    Dodano po 5 [minuty]:

    A czy mógłbym użyć "split", żeby narzucić excelowi w macro w jaki sposób ma interpretować otwierany plik? czyt. jak go dzielić? Czy on już go sobie wtedy podzieli dodatkowo?
  • #22
    PRL
    Level 40  
    Widocznie przerwałeś działanie makra, gdy plik nie został zamknięty.
    Żeby się nie męczyć (mam na myśli Ciebie i siebie), zamknij Excela, otwórz ponownie i uruchom makro 'F8'.
    Sprawdź, jak działa i jeżeli będziesz chciał, to dostasuj do swoich wymagań.

    P.S. Poniżej bez jednego blędu, który polegał na tym, że nie trafał do Excela wiersz z datą końcową.

    Edytowałem 2015-01-27 04:30:

    Code: vb
    Log in, to see the code
  • #23
    PRL
    Level 40  
    Quote:
    A czy mógłbym użyć "split", żeby narzucić excelowi w macro w jaki sposób ma interpretować otwierany plik? czyt. jak go dzielić? Czy on już go sobie wtedy podzieli dodatkowo?


    Split(Zmienna, "znak rozdzielający")
  • #24
    Jean1990
    Level 8  
    Problem rozwiązałem w inny sposób. Nagrałem macro podczas importowania pliku tekstowego przez Dane>Dane Zewnętrzne... i narzucania określonej kolumnie określonego formatu danych. Następnie sprawdziłem kod, dostałem coś takiego:
    Code:
    With ThisWorkbook.Sheets("Arkusz2").QueryTables.Add(Connection:= _
    
            sciezka, Destination:=Range("A1"))
            .Name = "S1_H0"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = xlWindows
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 2, 1, 1, 1)
            .Refresh BackgroundQuery:=False
        End With


    Wygląda brzydko i długaśnie, ale funkcjonuje tak jak trzeba. Po prostu dałem dodatkowy arkusz na bieżące operacje, ponieważ kopiuję dane do arkusza, po czym w nim wyszukuję datę. Jeżeli daty nie ma, zastępuje to danymi z następnego .csv itd.

    Bardzo dziękuję PRL za pomoc i nakierowanie mnie na właściwy tok myślenia.