Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

[VBA][Excel] Analiza zapisów partii szachowych

mateo786 25 Maj 2010 11:42 4860 28
  • #1 25 Maj 2010 11:42
    mateo786
    Poziom 9  

    Witam.
    Proszę o pomoc w stworzeniu programu w języku VBA. Będzie to makro Excela. Program ten będzie częścią mojej pracy licencjackiej. Program będzie analizował zapisy partii szachowych w formacie pgn. Na początku musi zaimportować z pliku/plików tekstowych zapisy partii. Następnie będzie analizował dane pod różnymi aspektami, to znaczy:
    policzy liczbę zwycięstw, porażek remisów. Może jakiś wykres stworzy względem czasu. Posortuje partie według otwarć szachowych, pokaże jakie otwarcia stosowane są najczęściej przez użytkownika i z jakim skutkiem.

    Na początku chciałbym się zająć importowaniem plików. Udało mi się stworzyć polecenie które importuje jeden plik. Chciałbym żeby importował kilka plików naraz do różnych arkuszy ale w jednym pliku. Powinien nazywać arkusze według nazwy pliku (ewentualnie z numerem jeśli już taka występuje). Zależy mi żeby końcowy kod być czytelny, czyli w razie potrzeby podzielony na funkcje.

    To jest kod który stworzyłem, umieszczam też plik excel.

    Code:

    Option Explicit
    Private Sub CommandButtonImportujPlik_Click()
    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
    Dim Arkusz, Sciezka, wyraz, Plik As String
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
        If .Show = True Then
            For Each varFile In .SelectedItems
            Sciezka = varFile
            Next
        Else
            MsgBox "Wcisnąłeś Cancel"
            Exit Sub
        End If
    End With
    Plik = Dir(Sciezka)
    createNewSheet (Plik)
    Cells.Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    Columns("F:F").Select
    Selection.NumberFormat = "####-##-##"
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0
    Do Until EOF(1) = True
        wyraz = CzytajCiagZnakow
        If wyraz = "Event" Then
        i = i + 1
        j = 0
        Range("A1").Offset(i, j) = wyraz
        j = j + 1
        Else
        Range("A1").Offset(i, j) = wyraz
        j = j + 1
        End If
    Loop
    MsgBox ("Zakończono importowanie pliku")
    Close (1)
    End Sub
    Function CzytajCiagZnakow() As String
    Dim CiagZnakow, Znak, Znak1 As String
    CiagZnakow = ""
    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
       
    Loop
    CzytajCiagZnakow = CiagZnakow
    End Function
    Function createNewSheet(nazwa As String) As Worksheet
        Dim Skoroszyt As Workbook
        Set Skoroszyt = Application.Workbooks.Add()
        Dim Arkusz As Worksheet
        For Each Arkusz In Skoroszyt.Worksheets
            If Arkusz.Name = "Arkusz1" Then
               Arkusz.Name = nazwa
            Else
               Application.DisplayAlerts = False
               Arkusz.Delete
               Application.DisplayAlerts = True
            End If
        Next
        Set createNewSheet = Skoroszyt.Worksheets(nazwa)
    End Function



    Proszę o jakieś poprawki, sugestie jak dalej tworzyć ten program. W razie potrzeby podam więcej szczegółów. Dołączam też przykładowy plik z zapisem partii.

    Poprawiłem temat.
    [Dr.Vee]

    0 28
  • #2 25 Maj 2010 12:50
    arnoldziq
    Moderator Programowanie

    Jeżeli oczekuje kolega jakiejkolwiek pomocy, to proszę usunąć pobieranie punktów za zamieszczony plik.

    0
  • #3 25 Maj 2010 14:11
    walek33
    Poziom 28  

    Popieram mojego poprzednika. To trochę dziwne podejście to tematu "Oczekuję od was pomocy ale mi za nią zapłaćcie".

    Jeżeli zaś chodzi o otwieranie

    mateo786 napisał:
    Na początku chciałbym się zająć importowaniem plików. Udało mi się stworzyć polecenie które importuje jeden plik. Chciałbym żeby importował kilka plików naraz do różnych arkuszy ale w jednym pliku.

    sugeruję rezygnację z dialogu i otwieranie plików w pętli za pomocą:
    Code:
    Workbooks.Open FileName:=""

    0
  • #4 25 Maj 2010 16:01
    mateo786
    Poziom 9  

    Przepraszam nie dopatrzyłem z tymi punktami. Rozumiem że jeśli chodzi o otwieranie wielu plików z fDialog będzie problem, jeśli skorzystam z Workbooks.Open FileName:="" to będę musiał podawać ścieżki do plików. Pytanie jak będzie wygodniej dla użytkownika? Będzie otwierane co najwyżej kilka plików.

    0
  • #5 25 Maj 2010 16:25
    marcinj12
    Poziom 40  

    Hej, skoro ta ma być praca licencjacka, to ja bym zaczął od:

    Code:
    Application.ScreenUpdating = False (na początku) 
    
    i Application.ScreenUpdating = True (na końcu i przed każdym Exit Sub)

    oraz
    Code:
    Application.Calculation = xlCalculationManual (na początku) 
    
    i Application.Calculation = xlCalculationAutomatic (na końcu i przed każdym Exit Sub)

    Przyspieszy pracę i użytkownikowi nie będzie "migać" przed oczami.

    Oprócz tego dodałbym jakąś obsługę błędów: proste
    Code:
    On Error goto myErr (na początku)
    

    i przed End Sub coś w stylu:

    Exit Sub
    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    żeby jak Ci się program wywali w czasie prezentacji użytkownik dostał ładny komunikat a nie wszedł w tryb debugowania.

    Zwróć też uwagę na przejrzystość kodu - prawdopodobnie Twój promotor będzie chciał go przeanalizować.
    Warto rozdzielać kod, np. nową funkcję, pojedynczym enterem, kod będzie czytelniejszy. Kwestią własnego stylu jest też rozdzielanie pojedynczym enterem poszczególnych sekcji kodu, ja np. jeżeli w funkcji mam 5 linijek wykonujących razem jakąś "akcję" rozdzielam ten blok enterem przed i po (z komentarzem co on robi), ale to jak mówię zależy od tego czy Ci z tym wygodnie...

    0
  • #6 25 Maj 2010 19:38
    mateo786
    Poziom 9  

    Uporałem się z importowaniem plików. Wstępnie wygląda to tak:

    Code:

    Option Explicit
    Private Sub CommandButtonImportujPlik_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
    Dim Plik As String
    Dim Sciezka() As String

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .AllowMultiSelect = True
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
        If .Show = True Then
            i = 0
            Erase Sciezka
            For Each varFile In .SelectedItems
            ReDim Preserve Sciezka(i)
            Sciezka(i) = varFile
            i = i + 1
            Next
        Else
            MsgBox "Wcisnąłeś Cancel"
            Exit Sub
        End If
    End With

    For j = 0 To i - 1
        Plik = Dir(Sciezka(j))
        ImportujPlik (Plik)
    Next j

    MsgBox ("Zakończono importowanie pliku/ów")
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Exit Sub
    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub ImportujPlik(Plik As String)

    Dim i, j As Integer
    Dim wyraz As String

    UtworzArkusz (Plik)
    Cells.Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    Columns("F:F").Select
    Selection.NumberFormat = "####-##-##"
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0

    Do Until EOF(1) = True
        wyraz = CzytajCiagZnakow
        If wyraz = "Event" Then
            i = i + 1
            j = 0
            Range("A1").Offset(i, j) = wyraz
            j = j + 1
        Else
            Range("A1").Offset(i, j) = wyraz
            j = j + 1
        End If
    Loop

    Close (1)
    End Sub

    Function CzytajCiagZnakow() As String

    Dim CiagZnakow, Znak, Znak1 As String

    CiagZnakow = ""

    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
    Loop

    CzytajCiagZnakow = CiagZnakow
    End Function

    Sub UtworzArkusz(Nazwa As String)

    Dim NowaNazwa As String
    Dim i As Integer

    NowaNazwa = Nazwa
    i = 0

    Do While Worksheet_Exists(NowaNazwa) = True
        i = i + 1
        NowaNazwa = Nazwa + Str(i)
    Loop

    Sheets.Add
    ActiveSheet.Name = NowaNazwa
    End Sub

    Function Worksheet_Exists(WorksheetName) As Boolean

    Dim x As Worksheet

    On Error Resume Next
    Set x = Worksheets(WorksheetName)

    If Err = 0 Then
        Worksheet_Exists = True
    Else
        Worksheet_Exists = False
    End If

    End Function

    Proszę o jakieś sugestie, co można uprościć w kodzie lub czego brakuje.
    W załączniku nowy plik źródłowy

    0
  • #7 25 Maj 2010 21:57
    marcinj12
    Poziom 40  

    Tak na szybko co mi się w oczy rzuciło:
    - jeszcze przed MsgBox "Wcisnąłeś Cancel" gdy wychodzisz z procedury warto przywrócić odświeżanie i automatyczne kalkulacje. Może warto je wrzucić do osobnej procedury, albo nie wychodzić Exit Sub, tylko ustawić np. zmienną boolowską "jest = False", a fragment kodu poniżej End With i komunikat "Wcisnąłeś cancel" uzależnić od jej stanu?

    - Jeżeli chodzi o uproszczenie - skoro chcesz wczytywać kilka plików jednocześnie może zamiast kombinowania z tablicą plików warto od razu odpalać funkcję importu pliku? Tablicy i tak później nie wykorzystujesz:

    Code:

    For Each varFile In .SelectedItems
           ImportujPlik (Dir(varFile))
    Next varFile

    Gdyby Ci "wisiało" okno dialogowe, daj DoEvents po if .Show

    -polecenie Cell.Select coś nie działa - albo zrób ActiveSheet.Cells.Select albo, jeszcze lepiej, po utworzeniu nowego arkusza ustaw na niego zmienną:np. Set wsnowy = ThisWorkbook.Worksheets(nazwa), i dalej rób: wsnowy.Cells.Select

    - unikaj zbędnych .Select, tak jak w przykładzie wyżej: zamiast pisać
    Code:

    Columns("F:F").Select
    Selection.NumberFormat = "####-##-##"

    napisz:
    Code:

    Columns("F:F").NumberFormat = "####-##-##"

    Będzie szybciej i poprawniej ;)

    0
  • #8 26 Maj 2010 09:36
    mateo786
    Poziom 9  

    Po sugerowanych poprawkach kod wygląda następująco:

    Code:

    Option Explicit
    Private Sub CommandButtonImportujPlik_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .AllowMultiSelect = True
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
       
        If .Show = True Then
            For Each varFile In .SelectedItems
            ImportujPlik (Dir(varFile))
            Next varFile
            KoniecOperacji ("Zakończono importowanie")
        Else
            KoniecOperacji ("Anulowano importowanie")
        End If

    Exit Sub

    End With

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub ImportujPlik(Plik As String)

    Dim i, j As Integer
    Dim Wyraz As String

    UtworzArkusz (Plik)
    ActiveSheet.Cells.NumberFormat = "@"
    Range("A1").Select
    ActiveSheet.Columns("F:F").NumberFormat = "####-##-##"
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0

    Do Until EOF(1) = True
        Wyraz = CzytajCiagZnakow
        If Wyraz = "Event" Then
            i = i + 1
            j = 0
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        Else
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        End If
    Loop

    Close (1)
    End Sub

    Function CzytajCiagZnakow() As String

    Dim CiagZnakow, Znak, Znak1 As String

    CiagZnakow = ""

    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
    Loop

    CzytajCiagZnakow = CiagZnakow
    End Function

    Sub UtworzArkusz(Nazwa As String)

    Dim NowaNazwa As String
    Dim i As Integer

    NowaNazwa = Nazwa
    i = 0

    Do While WorksheetExists(NowaNazwa) = True
        i = i + 1
        NowaNazwa = Nazwa + Str(i)
    Loop

    Sheets.Add
    ActiveSheet.Name = NowaNazwa
    End Sub

    Function WorksheetExists(WorksheetName) As Boolean

    Dim x As Worksheet

    On Error Resume Next
    Set x = Worksheets(WorksheetName)

    If Err = 0 Then
        WorksheetExists = True
    Else
        WorksheetExists = False
    End If

    End Function

    Function KoniecOperacji(Komunikat As String)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox (Komunikat)

    End Function

    Proszę o ewentualne jeszcze poprawki.
    Jak stworzę coś więcej to napiszę.

    0
  • #9 26 Maj 2010 09:58
    marcinj12
    Poziom 40  

    No, już lepiej :)
    Jeszcze fragment

    Code:
    Range("A1").Select
    
    ActiveSheet.Columns("F:F").NumberFormat = "####-##-##"
    można zbić w jedną linijkę. Unikaj robienia SELECT kiedy nie musisz, poczytaj o tym tutaj, #TIP5: Link
    Domyślnie nagrywając makro excel wstawia wszędzie ten select, robi Range(xxx).Select a dopiero później robi Selection.<akcja>, w praktyce 90% z nich można uniknąć i połączyć w Range(xxx).<akcja>

    Funkcja WorksheetExists działa, ale w zasadzie powoduje wystąpienie błędu (wyjątku) i na tej podstawia ustala czy arkusz jest otwarty... Niby dobrze, ale tak jakoś nieprogramistycznie ;) W dodatku ustawiasz zmianną x = Set ..., ale jej potem nie zwalniasz z pamięci: Set x = Nothing.
    Ja bym użył:
    Code:

    WorksheetExists = False
    For each ws in Worksheets
       if ws.Name = WorksheetName then
           WorksheetExists = True
           exit for
       end if
    next ws



    PS. MsgBox może wyglądać ładniej ;), z własnego doświadczenia powiem że - przynajmniej na uczelni - 50% wpływu na ocenę programu ma ładny interfejs ;P
    Code:
    MsgBox "Obliczenia zakończone", vbInformation, "Koniec"

    0
  • #10 26 Maj 2010 11:46
    mateo786
    Poziom 9  

    Dziękuję za uwagi, oto wersja po poprawkach. Moje pytanie.
    Czy po każdym wywołaniu rozkazu Set należało zwolnić pamięć?

    Cytat:

    W dodatku ustawiasz zmianną x = Set ..., ale jej potem nie zwalniasz z pamięci: Set x = Nothing.

    Czy w tym wypadku też:
    Code:

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    A oto kod źródłowy:

    Code:

    Option Explicit

    Private Sub CommandButtonImportujPlik_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .AllowMultiSelect = True
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
       
        If .Show = True Then
            For Each varFile In .SelectedItems
            ImportujPlik (Dir(varFile))
            Next varFile
            KoniecOperacji ("Zakończono importowanie")
        Else
            KoniecOperacji ("Anulowano importowanie")
        End If

    Exit Sub

    End With

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub ImportujPlik(Plik As String)

    Dim i, j As Integer
    Dim Wyraz As String

    UtworzArkusz (Plik)
    ActiveSheet.Cells.NumberFormat = "@"
    Range("A1").Columns("F:F").NumberFormat = "####-##-##"
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0

    Do Until EOF(1) = True
        Wyraz = CzytajCiagZnakow
        If Wyraz = "Event" Then
            i = i + 1
            j = 0
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        Else
            Range("A1").Offset(i, j) = Wyraz




            j = j + 1
        End If
    Loop

    Close (1)
    End Sub

    Function CzytajCiagZnakow() As String

    Dim CiagZnakow, Znak, Znak1 As String

    CiagZnakow = ""

    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
    Loop

    CzytajCiagZnakow = CiagZnakow
    End Function

    Sub UtworzArkusz(Nazwa As String)

    Dim NowaNazwa As String
    Dim i As Integer

    NowaNazwa = Nazwa
    i = 0

    Do While WorksheetExists(NowaNazwa) = True
        i = i + 1
        NowaNazwa = Nazwa + Str(i)
    Loop

    Sheets.Add
    ActiveSheet.Name = NowaNazwa
    End Sub

    Function WorksheetExists(WorksheetName As String) As Boolean

    Dim ws As Worksheet
    WorksheetExists = False

    For Each ws In Worksheets
        If ws.Name = WorksheetName Then
            WorksheetExists = True
            Exit For
        End If
    Next ws

    End Function

    Function KoniecOperacji(Komunikat As String)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox Komunikat, vbInformation, "Koniec"

    End Function


    Dodano po 4 [minuty]:

    Mam problem z funkcją która będzie zwracała tablicę z nazwami arkuszy.
    Code:

    Function CzytajArkusze() As Variant

    Dim i As Integer
    Dim ws As Worksheet

    i = 0
    CzytajArkusze = Array(i)
    For Each ws In Worksheets
        ReDim Preserve CzytajArkusze(i)
        CzytajArkusze(i) = ws.Name
        i = i + 1
    Next ws

    End Function

    Próbuje na różne sposoby ale zawsze jakiś błąd zgłasza.
    Możecie coś poradzić.

    Dodano po 3 [minuty]:

    Jeszcze jedno pytanie. Czy funkcje które nie zwracają wartości np.
    Code:

    Function KoniecOperacji(Komunikat As String)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox Komunikat, vbInformation, "Koniec"

    End Function

    Należało by przekształcić na procedury Sub?

    0
  • #11 26 Maj 2010 12:12
    marcinj12
    Poziom 40  

    mateo786 napisał:
    Czy po każdym wywołaniu rozkazu Set należało zwolnić pamięć?

    Prawdę powiedziawszy nie jestem do końca pewien, może ktoś inny wie lepiej:)
    Wg źródeł na necie, np. tego lub tego - ustawienie Set x = nothing zwalnia zasoby i pamięć przydzieloną do obiektu. Ja w praktyce rzadko to stosuję, jedynie do niektórych obiektów używanych więcej niż raz, dla FileDialog może bym i nie stosował bo wywołujesz go tylko raz w całym kodzie, ale już przypisanie Set x = Worksheets(WorksheetName) wykonujesz wielokrotnie w pętli, tam, przy większe ilości arkuszy - jeżeli faktycznie pamięć nie jest zwalniania - może to być problemem, więc lepiej nie ryzykować ;P

    Jeżeli chodzi o drugie, to operacja rozszerzenia tablicy na pewno jest bardziej czasochłonna niż utworzenie tablicy raz. W końcu znasz ilość arkuszy. Spróbuj coś takiego:
    Code:

    Function CzytajArkusze() As Variant
    Dim i As Integer
    Dim ws As Worksheet

    ReDim tabl(1 To ThisWorkbook.Worksheets.Count)   'ustalasz tablicę jeden raz

    i = 1
    For Each ws In ThisWorkbook.Worksheets
       tabl(i) = ws.Name
       i = i + 1
    Next ws

    CzytajArkusze = tabl
    End Function

    Moesz też zadeklarować tablicę: Private tabl() as String na początku całego kodu, wtedy działasz na zmiennej widocznej w całym zakresie i nie musisz niczego przekazywać jako wyniku funkcji, wtedy możesz zmienić ją na procedurę.

    I tak, funkcje które nie zwracają wartości należało by przekształcić na procedury Sub.

    0
  • #12 28 Maj 2010 16:39
    mateo786
    Poziom 9  

    Witam. Udało mi się stworzyć część analizującą dane. Na razie na pewno zawiera jeszcze dużo błędów. Roboczo dodałem pytanie o ilość analizowanych debiutów ponieważ strasznie długo to trwa. Analiza wszystkich pewnie potrwała by koło godziny. Proszę o dalsze sugestie, poprawki. Oto kod:

    Code:

    Option Explicit

    Private Sub CommandButtonImportujPlik_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .AllowMultiSelect = True
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
       
        If .Show = True Then
            For Each varFile In .SelectedItems
            ImportujPlik (Dir(varFile))
            Next varFile
            KoniecOperacji ("Zakończono importowanie")
        Else
            KoniecOperacji ("Anulowano importowanie")
        End If

    Exit Sub

    End With

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub ImportujPlik(Plik As String)

    Dim i As Integer, j As Integer
    Dim Wyraz As String

    UtworzArkusz (Plik)
    ActiveSheet.Cells.NumberFormat = "@"
    Range("A1").Columns("F:F").NumberFormat = "####-##-##" 'nie działa na całą kolumnę
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0

    Do Until EOF(1) = True
        Wyraz = CzytajCiagZnakow
        If Wyraz = "Event" Then
            i = i + 1
            j = 0
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        Else
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        End If
    Loop
    Range("W1").EntireColumn.Delete
    Close (1)
    End Sub

    Function CzytajCiagZnakow() As String

    Dim CiagZnakow As String, Znak As String, Znak1 As String

    CiagZnakow = ""

    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
    Loop

    CzytajCiagZnakow = CiagZnakow
    End Function

    Sub UtworzArkusz(Nazwa As String)

    Dim NowaNazwa As String
    Dim i As Integer

    NowaNazwa = Nazwa
    i = 0

    Do While WorksheetExists(NowaNazwa) = True
        i = i + 1
        NowaNazwa = Nazwa + Str(i)
    Loop

    Sheets.Add
    ActiveSheet.Name = NowaNazwa
    End Sub

    Function WorksheetExists(WorksheetName As String) As Boolean

    Dim ws As Worksheet
    WorksheetExists = False

    For Each ws In Worksheets
        If ws.Name = WorksheetName Then
            WorksheetExists = True
            Exit For
        End If
    Next ws

    End Function

    Sub KoniecOperacji(Komunikat As String)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox Komunikat, vbInformation, "Koniec"

    End Sub

    Private Sub CommandButtonAnalizuj_Click()
    Dim NazwaArkusza As String
    Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer
    Dim nowa(5) As Variant
    i = CzytajArkusze(0)
    For j = 0 To i

        MsgBox CzytajArkusze(j + 1)

        If WorksheetExists(CzytajArkusze(j + 1) + " Analiza") = False Then
            UtworzArkusz (CzytajArkusze(j + 1) + " Analiza")
        End If
       
        Statystyka (CzytajArkusze(j + 1))
        NazwaArkusza = CzytajArkusze(j + 1)
        m = 0
       
        For k = 0 To InputBox("Podaj liczbę debiutów do analizy")
           
            For l = 0 To 5
                nowa(l) = AnalizujDebiut(k, NazwaArkusza)(l)
               
            Next l
           
                Sheets(NazwaArkusza + " Analiza").Activate
            If nowa(0) <> Empty Then
            Range("A1").Offset(m + 2, 0) = nowa(0)
            Range("A1").Offset(m + 2, 1) = nowa(1) + nowa(2) + nowa(3)
            Range("A1").Offset(m + 2, 2) = nowa(1)
            Range("A1").Offset(m + 2, 3) = nowa(2)
            Range("A1").Offset(m + 2, 4) = nowa(3)
            Range("A1").Offset(m + 2, 5) = (nowa(1) * 100) / (nowa(1) + nowa(2) + nowa(3))
            Range("A1").Offset(m + 2, 6) = nowa(4) / (nowa(1) + nowa(2) + nowa(3))
            Range("A1").Offset(m + 2, 7) = nowa(5) / (nowa(1) + nowa(2) + nowa(3))
            End If
            'For l = 0 To 5
                'If nowa(0) <> Empty Then
                    'Range("A1").Offset(m + 2, l) = nowa(l)
                'End If
            'Next l
           
            If nowa(0) <> Empty Then
                m = m + 1
            End If
           
        Next k
       
    Next j
    End Sub

    Function CzytajArkusze() As Variant
    Dim i As Integer
    Dim ws As Worksheet
    Dim tab1() As String

    ReDim tabl(0 To ThisWorkbook.Worksheets.Count)
    i = 1

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "OtwarciaSzachowe" Then
            If Right(ws.Name, 7) <> "Analiza" Then
            tabl(i) = ws.Name
            i = i + 1
            End If
        End If
    Next ws

    tabl(0) = Str(i - 2)
    CzytajArkusze = tabl

    End Function

    Function AnalizujDebiut(NumerDebiutu As Integer, NazwaArkusza As String) As Variant

    Dim i As Byte, j As Long, k As Long, m As Integer, l As Integer
    Dim Debiut(45) As String
    Dim Partia(5) As Variant
    Dim Gracz As String

    Sheets("OtwarciaSZachowe").Activate
    i = 0

    Do Until Range("A1").Offset(NumerDebiutu, i) = Empty
        Debiut(i) = Range("A1").Offset(NumerDebiutu, i)
        i = i + 1
    Loop

    Sheets(NazwaArkusza).Activate

    'j - ilość niepustych wierszy w arkuszu
    For j = 1 To 65536
        If Not IsEmpty(ActiveSheet.Cells(j, 1)) Then
            ActiveSheet.Cells(j, 1) = j
        Else
            Exit For
        End If
    Next j

    Erase Partia
    Gracz = Left(NazwaArkusza, Len(NazwaArkusza) - 4)

    For k = 0 To j
        m = 0
        For l = 0 To i - 2
            If Range("A1").Offset(k, l + 22) = Debiut(l + 2) Then
                m = m + 1
            End If
        Next l
        If m = i - 2 Then
            Partia(0) = Debiut(1)
            If Range("A1").Offset(k, 13) = "1-0" Then
                If Range("A1").Offset(k, 9) = Gracz Then
                    Partia(1) = Partia(1) + 1
                Else
                    Partia(2) = Partia(2) + 1
                End If
            Else
                If Range("A1").Offset(k, 13) = "0-1" Then
                    If Range("A1").Offset(k, 9) = Gracz Then
                        Partia(2) = Partia(2) + 1
                    Else
                        Partia(1) = Partia(1) + 1
                    End If
                Else
                    Partia(3) = Partia(3) + 1
                End If
            End If
            Partia(4) = Partia(4) + Val(Range("A1").Offset(k, 15))
            If Range("A1").Offset(k, 9) = Gracz Then
                Partia(5) = Partia(5) + Val(Range("A1").Offset(k, 21))
            Else
                Partia(5) = Partia(5) + Val(Range("A1").Offset(k, 19))
            End If
        End If
    Next k

    AnalizujDebiut = Partia

    End Function

    Sub Statystyka(NazwaArkusza As String)
    Dim Czas As Long, Elo As Long, Wygrane As Long, Remisy As Long, Porazki As Long

    Dim i As Integer
    Dim Gracz As String

    Gracz = Left(NazwaArkusza, Len(NazwaArkusza) - 4)
    Sheets(NazwaArkusza).Activate
    i = 0

    Do Until Range("A1").Offset(i, 1) = Empty
        Czas = Czas + Val(Range("A1").Offset(i, 15))
        If Range("A1").Offset(i, 9) = Gracz Then
            Elo = Elo + Val(Range("A1").Offset(i, 21))
            If Range("A1").Offset(i, 13) = "1-0" Then
                Wygrane = Wygrane + 1
            End If
            If Range("A1").Offset(i, 13) = "0-1" Then
                Porazki = Porazki + 1
            End If
            If Range("A1").Offset(i, 13) = "1/2-1/2" Then
                Remisy = Remisy + 1
            End If
        Else
            Elo = Elo + Val(Range("A1").Offset(i, 19))
            If Range("A1").Offset(i, 13) = "1-0" Then
                Porazki = Porazki + 1
            End If
            If Range("A1").Offset(i, 13) = "0-1" Then
                Wygrane = Wygrane + 1
            End If
            If Range("A1").Offset(i, 13) = "1/2-1/2" Then
                Remisy = Remisy + 1
            End If
           
        End If
       
        i = i + 1
    Loop

    Sheets(NazwaArkusza + " Analiza").Activate
    Range("A1").Offset(0, 0) = "Otwarcie szachowe"
    Range("A1").Offset(1, 0) = "Wszystkie partie"
    Range("A1").Offset(0, 1) = "Rozegrane partie"
    Range("A1").Offset(1, 1) = Wygrane + Remisy + Porazki
    Range("A1").Offset(0, 2) = "Wygrane"
    Range("A1").Offset(1, 2) = Wygrane
    Range("A1").Offset(0, 3) = "Porażki"
    Range("A1").Offset(1, 3) = Porazki
    Range("A1").Offset(0, 4) = "Remisy"
    Range("A1").Offset(1, 4) = Remisy
    Range("A1").Offset(0, 5) = "Procent wygranych"
    Range("A1").Offset(1, 5) = (Wygrane * 100) / (Wygrane + Porazki + Remisy)
    Range("A1").Offset(0, 6) = "Średni czas"
    Range("A1").Offset(1, 6) = Czas / (Wygrane + Porazki + Remisy)
    Range("A1").Offset(0, 7) = "Średnie ELO"
    Range("A1").Offset(1, 7) = Elo / (Wygrane + Porazki + Remisy)
    End Sub


    Załączam też plik źródłowy.

    0
  • #13 28 Maj 2010 18:57
    marcinj12
    Poziom 40  

    Analiza trwa godzinę?? Na pewno kod można zoptymalizować, danych nie ma aż tak dużo. Jak dla mnie kilka minut to już by było za dużo.

    Tak na szybko (bo kod za długi żeby cały analizować ;P) parę uwag:

    - w przycisku ANALIZUJ znowu zgubiłeś Application.ScreenUpdating =... i Application.Calculation = ... Przez to na pewno wolniej działa. Wyrób sobie dobry nawyk i zaczynaj pisanie kodu dla nowych przycisków od tych linijek na początku i na końcu. Obsługa błędów też mile widziana...

    - Polecam testowanie fragmentów za pomocą debugera i zegarka ze stoperem ;) Ustawiasz break przed jakimś fragmentem kodu i po, potem F5 dochodzisz do jednego, uruchamiasz stoper i drugi raz F5 - aż się zatrzyma na drugim braeku. W ten sposób ustalisz "wąskie gardła" które należy zoptymalizować.

    - Unikaj powtarzania wywołań funkcji, np. masz 4 wywołania funkcji CzytajArkusze(j + 1). Jakbyś leciał krok po kroku F8 to byś zobaczył, że w każdym z tych miejsc wywołujesz funkcję robiącą to samo.
    Wywołaj ją tam gdzie możesz raz, np. przeczytany_arkusz = CzytajArkusze(j + 1), a w pozostałych 3 miejscach odwołuj się do zmiennej przeczytany_arkusz

    - mów do użytkownika :) Ja np. odpaliłem Twój program, zwiesił się i teraz nie wiem czy coś liczy, cyz się zawiesił, czy mam go ubić, jak długo może to potrwać?? Pogooglaj o VBA ProgressBar, albo przynajmniej wykorzystaj możliwość pisania do status bar. Może odrobinę spowolni to aplikację, ale użytkownik zyska feedback.

    Code:

    'gdzieś w pętli, np. for i = 1 to max_ilosc
    Application.StatusBar = "Obliczanie: " & i & "/" & max_ilosc
    ....

    'po wyjściu z pętli:
    Application.StatusBar = False


    - tu niektórzy mogą się ze mną nie zgodzić, ale NIE RÓB tak: Cells.Select, Range("A1"), Columns("F:F") etc. ZAWSZE podawaj do którego KONKRETNIE arkusza chcesz zastosować akcję. Albo pisz: Sheets("Arkusz1").Cells.Select, albo Sheets(plik).Range("A1") albo - to mój ulubiony sposób - zadeklaruj raz, na początku kodu (lub tam gdzie jest to możliwe) arkusz(e):
    Code:

    Set wsark1 = ThisWorkbook.Worksheets("Arkusz1")

    'a w kodzie używaj
    wsark1.Cells.Select
    wsark1.Range("A1")
    wsark.Columns("F:F")

    Raz że jest to czytelniejsze (od razu wiadomo na którym arkuszu kod działa), to zabezpieczasz się przed przypadkami kiedy aktywując inne arkusz makro zaczyna działać na tym aktywowanym zamiast na starym. O dziwo ;-], magiczne: ActiveSheet.Columns("F:F").NumberFormat = "####-##-##" działa na całą kolumnę...

    - nie podoba mi się fragment czytający plik znak po znaku. Przerób kod tak, żeby zamiast czytać po jednym znaku:
    Code:
    Znak = Input(1, #1)

    wczytał całą linijkę:
    Code:
    Input #1, linia 

    i potem działaj na wartości linii wczytanej do pamięci.
    Polecenia które mogą Ci się przydać:
    Code:

    Len(linia)   'ilość znaków w zmiennej linia
    left(linia, 3)   'trzy pierwsze znaki zmiennej linia
    right(linia, 5)   '5 ostatnich znaków zmiennej linia
    mid(linia, 3, 2)   'znaki od 3 do 5 zmiennej linia
    InStr(linia, "ala")    'zwraca pozycję wyrazu ala w zmiennej linia lub 0 gdy nie występuje


    - tam gdzie masz wczytane kody ruchów oddzielone spacjami zastosuj "magiczną" funkcję Split(), która potrafi rozbić ciąg znaków na tablice wg określonego delimitera: czary-mary i mamy:
    Code:
    napis = "Ala ma kota i psa"
    
    arr = Split(napis)

    For Each c In arr
       MsgBox c
    Next c

    Możesz chcieć skakać np. co 3 element w tablicy, wtedy:
    Code:

    max_tabl = UBound(arr)   'górny wymiar tablicy
    For i = 1 to max_tabl Step 3
       MsgBox tabl(i)
    Next i


    - unikaj kilku zmiennych If które sprawdzają po sobie to samo, np. fragment:
    Code:

            If Range("A1").Offset(i, 13) = "1-0" Then
                Wygrane = Wygrane + 1
            End If
            If Range("A1").Offset(i, 13) = "0-1" Then
                Porazki = Porazki + 1
            End If
            If Range("A1").Offset(i, 13) = "1/2-1/2" Then
                Remisy = Remisy + 1
            End If

    albo zagnieźdź jedne ify w drugich, albo najlepiej wykorzystaj instrukcję warunkową select:
    Code:

            Select Case Range("A1").Offset(i, 13)
               case "1-0"
                   Wygrane = Wygrane + 1
               case "0-1"
                   Porazki = Porazki + 1
               case "1/2-1/2"
                   Remisy = Remisy + 1
            End Select

    Instrukcji Select możesz też użyć przy czytaniu linii do ustalenia, co za typ danych zawierają (event, round, date etc., wystarczy przeczytać kilka poczatkowych znaków i na nich sprawdzać czy psuja do wzorca).

    - wyrażenia typu nowa(4) / (nowa(1) + nowa(2) + nowa(3)): jak już dzielisz przez coś to upewnij się, że to nie będzie zerem :)

    - wyrażenie:
    Code:

    'j - ilość niepustych wierszy w arkuszu
    For j = 1 To 65536
        If Not IsEmpty(ActiveSheet.Cells(j, 1)) Then
            ActiveSheet.Cells(j, 1) = j
        Else
            Exit For
        End If
    Next j

    wooooooooolne...
    Szybkie i pewne? Polecam:
    Code:

    j = ActiveSheet.Range("B65536").End(xlUp).Row   'w zasadzie wyszukuje ostatnią niepustą komórkę w kolumnie B

    W ogóle tam gdzie tylko przeglądasz zakres unikaj For ... To, zrób to na For Each .. For Each jest naprawdę masakrycznie szybsze :)


    Sporo tego, ale jak przeanalizujesz dokładnie co napisałem i zastosujesz w swoim kodzie, powinno się polepszyć :) Wprowadź poprawki tak, żeby kod działał, to ewentualnie poszukamy dalszych ulepszeń...
    Pozdrawiam

    0
  • #14 31 Maj 2010 14:23
    mateo786
    Poziom 9  

    Zrobiłem kilka poprawek ale zawiesiłem się na kontrolce Progress Bar. Nie wiem jak to ugryźć. Przejrzałem trochę informacji na ten temat ale nie znalazłem rozwiązania. Proszę o jakąś wskazówkę.

    Code:

    Private Sub CommandButtonAnalizuj_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim NazwaArkusza As String
    Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer
    Dim nowa(5) As Variant
    Dim ProgressBar As New ProgressBar

    i = CzytajArkusze(0)
    For j = 0 To i
        NazwaArkusza = CzytajArkusze(j + 1)
        MsgBox NazwaArkusza

        If WorksheetExists(NazwaArkusza + " Analiza") = False Then
            UtworzArkusz (NazwaArkusza + " Analiza")
        End If
       
        Statystyka (NazwaArkusza)
       
        m = 0
        n = InputBox("Podaj liczbę debiutów do analizy")
       
       
        ProgressBar.ProgressBar1.Min = 0
        ProgressBar.ProgressBar1.Max = n
        ProgressBar.ProgressBar1.Value = 0
        ProgressBar.ProgressBar1.Visible = True
        ProgressBar.Show
           
        For k = 0 To n
           
            ProgressBar.ProgressBar1.Value = k
            ProgressBar.ProgressBar1.Refresh
           
            DoEvents
                   
            For l = 0 To 5
                nowa(l) = AnalizujDebiut(k, NazwaArkusza)(l)
            Next l
                   
            Sheets(NazwaArkusza + " Analiza").Activate
           
            If nowa(0) <> Empty Then
            Range("A1").Offset(m + 2, 0) = nowa(0)
            Range("A1").Offset(m + 2, 1) = nowa(1) + nowa(2) + nowa(3)
            Range("A1").Offset(m + 2, 2) = nowa(1)
            Range("A1").Offset(m + 2, 3) = nowa(2)
            Range("A1").Offset(m + 2, 4) = nowa(3)
            Range("A1").Offset(m + 2, 5) = (nowa(1) * 100) / (nowa(1) + nowa(2) + nowa(3))
            Range("A1").Offset(m + 2, 6) = nowa(4) / (nowa(1) + nowa(2) + nowa(3))
            Range("A1").Offset(m + 2, 7) = nowa(5) / (nowa(1) + nowa(2) + nowa(3))
            End If
           
            If nowa(0) <> Empty Then
                m = m + 1
            End If
           
        Next k

    Next j

    Exit Sub

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    0
  • #15 31 Maj 2010 15:21
    marcinj12
    Poziom 40  

    Po pierwsze - musisz jakoś pokazywać formę Chess.
    Wstaw sobie np. button, który będzie otwierał tą formę z parametrem vbModeless:

    Code:
    Chess.Show (vbModeless)


    Po drugie - jak chcesz wyświetlić formę ProgressBar, musisz ją wywołać tak samo:
    Code:
    ProgressBar.Show (vbModeless)
    - ważny jest parametr, ponieważ zwykłe Show() otwiera formę i czeka z wykonywaniem kodu aż użytkownik ją zamknie. To właśnie się działo u Ciebie.

    Dalej: jeżeli robisz DoEvents, nie musisz robić ProgressBar.ProgressBar1.Refresh, zaoszczędzisz trochę czasu przy przerysowywaniu formy. ProgressBar.ProgressBar1.Visible = True jest zbędny.

    I w końcu:
    kiedy chcesz zamknąć formę z paskiem postępu, wstawiasz (np. przed Exit Sub) Unload ProgressBar (albo ProgressBar.Hide() żeby tylko ukryć).

    Swoją drogą, skoro masz już formę z przyciskami może warto tam wrzucić pasek postępu, po co Ci dodatkowa forma??
    PS. W funkcji CzytajArkusze() miałeś zadeklarowaną tab1 zamiast tabl, przez co się kod wywalał ;P

    Pozdrawiam

    0
  • #16 01 Cze 2010 09:49
    mateo786
    Poziom 9  

    Dodałem pasek postępu narazie tylko do przycisku Analizuj. Mam pytanie odnośnie tego fragmentu kodu:

    Code:

    For l = 0 To 5
         nowa(l) = AnalizujDebiut(k, NazwaArkusza)(l)
    Next l

    Rozumiem że funkcja AnalizujDebiut jest wywoływana 5 razy. Zwraca ona tablicę plików. Czy mogę tą tablicę przypisać od razu do zmiennej bez użycia pętli? Czy jedynym wyjściem będzie zadeklarowanie publicznej tablicy?

    Dołączam nowy plik źródłowy

    0
  • #17 01 Cze 2010 10:28
    marcinj12
    Poziom 40  

    Jeżeli funkcja

    Code:
    AnalizujDebiut(k, NazwaArkusza)
    zwraca tablicę, to możesz zrobić coś takiego:
    Code:
    Dim nowa as Variant
    
    nowa = AnalizujDebiut(k, NazwaArkusza)

    Wtedy w zmiennej nowa będzie zwrócona tablica

    0
  • #18 01 Cze 2010 10:54
    mateo786
    Poziom 9  

    Przy próbie przypisania w ten sposób:

    Code:

    nowa = AnalizujDebiut(k, NazwaArkusza)

    Wyskakuje błąd:
    Code:

    Can't assign to array


    Dodano po 3 [minuty]:

    Dobra rozgryzłem to. Cały czas miałem zmienną nowa zadeklarowaną jako tablice. Program teraz przyspieszył znacząco:)

    0
  • #19 02 Cze 2010 16:12
    mateo786
    Poziom 9  

    Popracowałem trochę nad programem. Działa już znacznie szybciej. Mam problem chcę aby program wypisywał do TextBox'a komunikaty, za każdym razem do nowej linii. Część komunikatów będzie jednak odświeżana np komunikat o postępie.

    Kod obecnie wygląda następująco:

    Code:


    Option Explicit

    Private Sub CommandButtonImportujPlik_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i, j As Integer
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .AllowMultiSelect = True
        .Title = "Otwórz"
        .Filters.Clear
        .Filters.Add "Pliki tekstowe", "*.txt"
        .Filters.Add "Pliki Portable Game Notation", "*.pgn"
       
        If .Show = True Then
            For Each varFile In .SelectedItems
            ImportujPlik (Dir(varFile))
            Next varFile
            KoniecOperacji ("Zakończono importowanie")
        Else
            KoniecOperacji ("Anulowano importowanie")
        End If

    Exit Sub

    End With

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Sub ImportujPlik(Plik As String)

    Dim i As Integer, j As Integer
    Dim Wyraz As String

    UtworzArkusz (Plik)
    ActiveSheet.Cells.NumberFormat = "@"
    Range("A1").Columns("F:F").NumberFormat = "####-##-##"
    Range("A1").Select
    Open Plik For Input As #1
    i = -1
    j = 0

    Do Until EOF(1) = True
        Wyraz = CzytajCiagZnakow
        If Wyraz = "Event" Then
            i = i + 1
            j = 0
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        Else
            Range("A1").Offset(i, j) = Wyraz
            j = j + 1
        End If
    Loop
    Range("W1").EntireColumn.Delete
    Close (1)
    End Sub

    Function CzytajCiagZnakow() As String

    Dim CiagZnakow As String, Znak As String, Znak1 As String

    CiagZnakow = ""

    Do Until Znak1 = " " Or Znak1 = Chr(13) Or EOF(1) = True
        Znak = Input(1, #1)
        Znak1 = Znak
        If Znak = "[" Or Znak = "]" Or Znak = Chr(34) Or Znak = Chr(13) Or Znak = " " Or Znak = Chr(10) Or Znak = "." Then
            Znak = ""
        Else
            CiagZnakow = CiagZnakow & Znak
        End If
    Loop

    CzytajCiagZnakow = CiagZnakow
    End Function

    Sub UtworzArkusz(Nazwa As String)

    Dim NowaNazwa As String
    Dim i As Integer

    NowaNazwa = Nazwa
    i = 0

    Do While WorksheetExists(NowaNazwa) = True
        i = i + 1
        NowaNazwa = Nazwa + Str(i)
    Loop

    Sheets.Add
    ActiveSheet.Name = NowaNazwa
    End Sub

    Function WorksheetExists(WorksheetName As String) As Boolean

    Dim ws As Worksheet
    WorksheetExists = False

    For Each ws In Worksheets
        If ws.Name = WorksheetName Then
            WorksheetExists = True
            Exit For
        End If
    Next ws

    End Function

    Sub KoniecOperacji(Komunikat As String)

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    TextBox1.Text = TextBox1.Text & vbCrLf & Komunikat
    End Sub

    Private Sub CommandButtonAnalizuj_Click()

    On Error GoTo myErr
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    TextBox1.Text = TextBox1.Text & "Rozpoczęto analizę" & vbCrLf
    DoEvents

    Dim NazwaArkusza As Variant
    Dim i As Integer, j As Integer, k As Long, l As Byte, m As Integer
    Dim nowa As Variant
    Dim ProgressBar As New ProgressBar
    NazwaArkusza = CzytajArkusze
    i = NazwaArkusza(0)
    For j = 0 To i
       
       
        If WorksheetExists(NazwaArkusza(j + 1) + " Analiza") = False Then
            UtworzArkusz (NazwaArkusza(j + 1) + " Analiza")
        End If
       
        Statystyka (NazwaArkusza(j + 1))
       
        m = 0
           
        ProgressBar1.Min = 0
        ProgressBar1.Max = 2725
        ProgressBar1.Value = 0
        ProgressBar1.Visible = True
         
        For k = 0 To 2725
           
            TextBox1.Text = TextBox1.Text & "Twra analizowanie pliku " + NazwaArkusza(j + 1) + ". Ukończono " + Str(Int(k / 27.25)) + " %"
            ProgressBar1.Value = k
            DoEvents
             
            nowa = AnalizujDebiut(k, NazwaArkusza(j + 1))
           
            If nowa(0) <> Empty Then
               
           
           
            Sheets(NazwaArkusza(j + 1) + " Analiza").Activate
           
           
            Range("A1").Offset(m + 2, 0) = nowa(0)
            Range("A1").Offset(m + 2, 1) = nowa(1) + nowa(2) + nowa(3)
            Range("A1").Offset(m + 2, 2) = nowa(1)
            Range("A1").Offset(m + 2, 3) = nowa(2)
            Range("A1").Offset(m + 2, 4) = nowa(3)
           
            If (nowa(1) + nowa(2) + nowa(3)) > 0 Then
                Range("A1").Offset(m + 2, 5) = Int((nowa(1) * 100) / (nowa(1) + nowa(2) + nowa(3)))
                Range("A1").Offset(m + 2, 6) = Int(nowa(4) / (nowa(1) + nowa(2) + nowa(3)))
                Range("A1").Offset(m + 2, 7) = Int(nowa(5) / (nowa(1) + nowa(2) + nowa(3)))
            End If
                   
            m = m + 1
            End If
        Next k
        ProgressBar1.Visible = False
        Label1 = Empty
       
    Next j

    KoniecOperacji ("Zakończono analizę arkusza " + NazwaArkusza(j + 1))
    Exit Sub

    myErr:
        MsgBox Err.Description, vbCritical, "Błąd podczas obliczeń"
        Application.ScreenUpdating = True
        If Application.Calculation <> xlCalculationAutomatic Then Application.Calculation = xlCalculationAutomatic

    End Sub

    Function CzytajArkusze() As Variant
    Dim i As Integer
    Dim ws As Worksheet
    Dim tabl() As String

    ReDim tabl(0 To ThisWorkbook.Worksheets.Count)
    i = 1

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "OtwarciaSzachowe" Then
            If Right(ws.Name, 7) <> "Analiza" Then
            tabl(i) = ws.Name
            i = i + 1
            End If
        End If
    Next ws

    tabl(0) = Str(i - 2)
    CzytajArkusze = tabl

    End Function

    Function AnalizujDebiut(NumerDebiutu As Long, NazwaArkusza As Variant) As Variant

    Dim i As Byte, j As Long, k As Long, m As Integer, l As Integer
    Dim Debiut(45) As String
    Dim Partia(6) As Variant
    Dim Gracz As String

    Sheets("OtwarciaSzachowe").Activate
    i = Range("A1").Offset(NumerDebiutu, 45).End(xlToLeft).Column

    For l = 0 To i - 1
    Debiut(l) = Range("A1").Offset(NumerDebiutu, l)
    Next l

    Sheets(NazwaArkusza).Activate

    j = ActiveSheet.Range("A65536").End(xlUp).Row

    Erase Partia
    Gracz = Left(NazwaArkusza, Len(NazwaArkusza) - 4)

    For k = 0 To j
        m = 0
        For l = 0 To i - 3
            If Range("A1").Offset(k, l + 22) = Debiut(l + 2) Then
                m = m + 1
            Else
                GoTo nextk
            End If
        Next l
        If m = i - 2 Then
            Partia(0) = Debiut(1)
           
            If Range("A1").Offset(k, 9) = Gracz Then
                Select Case Range("A1").Offset(k, 13)
                Case "1-0"
                    Partia(1) = Partia(1) + 1
                Case "0-1"
                    Partia(2) = Partia(2) + 1
                Case "1/2-1/2"
                    Partia(3) = Partia(3) + 1
                Case Else
                   
                End Select
            Else
                Select Case Range("A1").Offset(k, 13)
                Case "1-0"
                    Partia(2) = Partia(2) + 1
                Case "0-1"
                    Partia(1) = Partia(1) + 1
                Case "1/2-1/2"
                    Partia(3) = Partia(3) + 1
                Case Else
               
                End Select
            End If
           
            Partia(4) = Partia(4) + Val(Range("A1").Offset(k, 15))
            If Range("A1").Offset(k, 9) = Gracz Then
                Partia(5) = Partia(5) + Val(Range("A1").Offset(k, 21))
            Else
                Partia(5) = Partia(5) + Val(Range("A1").Offset(k, 19))
            End If
        End If
    nextk:
    Next k
           
    AnalizujDebiut = Partia

    End Function

    Sub Statystyka(NazwaArkusza As String)

    Dim Partia(4) As Long
    Dim i As Integer
    Dim Gracz As String

    Gracz = Left(NazwaArkusza, Len(NazwaArkusza) - 4)
    Sheets(NazwaArkusza).Activate
    i = 0

    Do Until Range("A1").Offset(i, 1) = Empty
        Partia(3) = Partia(3) + Val(Range("A1").Offset(i, 15))
        If Range("A1").Offset(i, 9) = Gracz Then
            Partia(4) = Partia(4) + Val(Range("A1").Offset(i, 21))
            Select Case Range("A1").Offset(i, 13)
            Case "1-0"
                Partia(0) = Partia(0) + 1
            Case "0-1"
                Partia(1) = Partia(1) + 1
            Case "1/2-1/2"
                Partia(2) = Partia(2) + 1
            End Select
        Else
            Partia(4) = Partia(4) + Val(Range("A1").Offset(i, 19))
            Select Case Range("A1").Offset(i, 13)
            Case "1-0"
                Partia(1) = Partia(1) + 1
            Case "0-1"
                Partia(0) = Partia(0) + 1
            Case "1/2-1/2"
                Partia(2) = Partia(2) + 1
            End Select
        End If
       
        i = i + 1
    Loop

    Sheets(NazwaArkusza + " Analiza").Activate
    Range("A1").Offset(0, 0) = "Otwarcie szachowe"
    Range("A1").Offset(1, 0) = "Wszystkie partie"
    Range("A1").Offset(0, 1) = "Rozegrane partie"
    Range("A1").Offset(1, 1) = Partia(0) + Partia(2) + Partia(1)
    Range("A1").Offset(0, 2) = "Wygrane"
    Range("A1").Offset(1, 2) = Partia(0)
    Range("A1").Offset(0, 3) = "Porażki"
    Range("A1").Offset(1, 3) = Partia(1)
    Range("A1").Offset(0, 4) = "Remisy"
    Range("A1").Offset(1, 4) = Partia(2)
    Range("A1").Offset(0, 5) = "Procent wygranych"
    Range("A1").Offset(0, 6) = "Średni czas"
    Range("A1").Offset(0, 7) = "Średnie ELO"

    If Partia(0) + Partia(1) + Partia(2) > 0 Then
        Range("A1").Offset(1, 5) = Int((Partia(0) * 100) / (Partia(0) + Partia(1) + Partia(2)))
        Range("A1").Offset(1, 6) = Int(Partia(3) / (Partia(0) + Partia(1) + Partia(2)))
        Range("A1").Offset(1, 7) = Int(Partia(4) / (Partia(0) + Partia(1) + Partia(2)))
    End If

    End Sub



    Dołączam plik źródłowy

    0
  • #20 02 Cze 2010 18:18
    marcinj12
    Poziom 40  

    No to korepetycji ciąg dalszy ;)
    1. Tak mi się jeszcze rzuciło w oczy: polecenie

    Code:
    Range("A1").Columns("F:F").NumberFormat = "####-##-##"

    to Range("A1") z przodu chyba niepotrzebne?

    2. Pewnie zauważyłeś, że w pętli po każdym DoEvents denerwująco miga kursor (z klepsydry na moment zmienia się w normalny i po chwili z powrotem)? Możesz przed wejściem do pętli ustawić go na stałe poleceniem:
    Code:
    Application.Cursor = xlWait
    , a po wyjściu z pętli przywrócić go do normalnej postaci poleceniem
    Code:
    Application.Cursor = xlNormal

    Złe wieści to takie, że jeżeli aplikacja np. wyrzuci błąd albo wyjdziesz z niej przed przywróceniem normalnego kursora, pozostanie klepsydra - więc w każdym miejscu kodu do którego może wyjść pętla należałoby wstawić to przywracanie.

    3. Powyższego problemu unikniesz, jeśli zamiast DoEvents będziesz stosował Repaint, jednak wtedy forma pozostanie "głucha" na wszelkie próby jej zamknięcia, przesunięcia etc.

    4. Moim zdaniem robisz DoEvents stanowczo za często, pętle która zajmuje 2725x wykonuje to polecenia tyleż samo. Moja propozycja rozwiązania tego problemu (+opisanego przez Ciebie) jest następująca:
    Code:

    '.....
    ProgressBar1.Min = 0
        ProgressBar1.Max = 2725
        ProgressBar1.Value = 0
        ProgressBar1.Visible = True
       
        Dim tekst_poczatkowy As String
        Dim postep_procent As Integer
        Dim poprzedni_procent As Integer

        tekst_poczatkowy = TextBox1.Text   'przed wejściem w pętlę zapisujemy bieżący stan textboxa
        For k = 0 To 2725
            postep_procent = k / 27.25
            If postep_procent <> poprzedni_procent Then
                poprzedni_procent = postep_procent
                TextBox1.Text = ""
                TextBox1.Text = tekst_poczatkowy & "Trwa analizowanie pliku " & NazwaArkusza(j + 1) & ". Ukończono " & CStr(postep_procent) & " %"
                ProgressBar1.Value = k
                 DoEvents
            End If
            nowa = AnalizujDebiut(k, NazwaArkusza(j + 1))
           
            If nowa(0) <> Empty Then
    '......

    Czyli wykonujesz analizę dla każdego k z pętli, jednak update textboxa robisz jedynie wtedy kiedy jest konieczny (przy zmianie procentu na nowy). Mignie kursora jest mniej denerwujące a i program niepotrzebnie nie przepisuje tej samej treści co kilka razy (to samo dotyczy update'u progressbara)

    5. Wskazówka: nie rób czegoś takiego:
    Code:
    Sheets(NazwaArkusza(j + 1) + " Analiza").Activate
    
            Range("A1").Offset(m + 2, 0) = nowa(0)
    ...

    Wykonujesz to kilkaset razy w ciągu pętli, a polecenie Activate jest dosyć czasochłonne.
    Zrób coś takiego:
    Code:

    'przed wejściem w pętlę For k = 0 To 2725
    Dim wstmp as Worksheet
    Set wstmp = ThisWorkbook.Worksheets(CStr(NazwaArkusza(j + 1) & " Analiza"))

    For k = 0 To 2725
    .....

    'i przed każdym Range(".....) zrób coś podobnego:
    wstmp.Range("A1").Offset(m + 2, 0) = nowa(0)



    I nie stosuj jak nie musisz tego Offset(...). Jeżeli chcesz coś zapisać do arkusza do komórki w wierszu 5, w kolumnie 10, piszesz:
    Code:
    Cells(5, 10) = ...

    Jeżeli do komórki w wierszy m+2, w kolumnie 1 arkusza wstmp:
    Code:
    wstmp.Cells(m+2, 1) = 

    Stosując offset excel musi każdorazowo dodatkowo "w tle" przeliczyć przesunięcie względem komórki pierwotnej (w Twoim przypadku A1) o x wierszy w lewo i y kolumn w prawo. Na pewno zajmuje mu to więcej czasu, niż kiedy od razu mu podasz, w którą komórkę chcesz coś wpisać / odczytać używając Cells().

    Pozdrawiam

    0
  • #21 02 Cze 2010 23:39
    Dr.Vee
    VIP Zasłużony dla elektroda

    Kolego mateo786, proszę nie wklejać po 10 razy tego samego kodu do postu. Wystarczy załącznik plus ewentualnie opis/ilustracja zmian lub pokolorowany diff.

    Pozdrawiam,
    Dr.Vee

    0
  • #22 04 Cze 2010 12:14
    mateo786
    Poziom 9  

    Mam problem z procedurą CzytajCiagZnakow.

    Code:

    Function CzytajCiagZnakow() As Variant

    Dim Wyraz As Variant
    Dim Linia As String
    Dim TabLinia As Variant
    Dim TabWyrazy() As String
    Dim i As Integer, j As Integer

    Wyraz = ""
    i = 0
    j = 1000
    ReDim TabWyrazy(j)

    Do Until EOF(1) = True
       
        Input #1, Linia
        TabLinia = Split(Linia)
        For Each Wyraz In TabLinia
            TabWyrazy(i) = Wyraz
            'usuwanie znaków []".
            i = i + 1
                   
            If i = j Then
                ReDim Preserve TabWyrazy(j + 1)
                j = j + 1
            End If
           
        Next Wyraz
       
    Loop

    CzytajCiagZnakow = TabWyrazy

    End Function

    Próbuję przerobić tą procedurę według podanych wskazówek. Ale mam problem.
    Nie działa mi chyba warunek EOF(1)=true.

    Druga sprawa do nie wiem jak najlepiej będzie usuwać pewne znaki z wyrazu.

    Załączam plik źródłowy.

    0
  • #23 04 Cze 2010 15:25
    mateo786
    Poziom 9  

    Pomyliłem załączniki. Dołączam prawidłowy plik.

    Dodano po 12 [minuty]:

    Z pierwszym problemem sobie poradziłem. Zostało tylko usuwanie znaków z wyrazów.

    0
  • #24 04 Cze 2010 17:21
    marcinj12
    Poziom 40  

    Od usuwania znaków jest funkcja Replace(), np.

    Code:
    wynik = Replace("Ala ma kota", "kota", "psa")
    da wynik = "Ala ma psa". Użyj dwa razy zamieniając [ i ] na pusty ciąg.
    Jeżeli chcesz zastąpić tylko we fragmencie, to funkcja ma opcjonalne parametry "start od pozycji..." oraz "ilość zastąpień". W razie czego wygooglaj szcegóły.

    0
  • #25 05 Cze 2010 13:27
    mateo786
    Poziom 9  

    Po proponowanych zmianach program wygląda tak. Proszę o ewentualne wskazówki dotyczące funkcjonalności, poprawności kodu. Zastanawiam się jeszcze nad funkcją która automatycznie dopasowywała by szerokość komórek w arkuszu, tylko nie wiem w jaki sposób najlepiej to rozwiązać.

    W załączniku plik źródłowy.

    0
  • #26 05 Cze 2010 15:44
    marcinj12
    Poziom 40  

    - Ja bym jeszcze dodał polecenie

    Code:

    Close (1)
    Open Plik For Input As #1

    Jeżeli wystąpi błąd w trakcie wczytywania, excel lubi zostawić zablokowany plik tekstowy, skutkiem czego kolejna próba wczytania się nie powiedzie. Próba zamknięcia przed otwarciem zapobiegnie temu.

    - W pętli
    Code:
    For Each Wyraz In TabWyrazow
    
        If Wyraz = "Event" Then
            j = 1
            i = i + 1
            WsTmp.Cells(i, j) = TabWyrazow(k)
            j = j + 1
        Else
            WsTmp.Cells(i, j) = TabWyrazow(k)
            j = j + 1
        End If
        k = k + 1
    Next Wyraz
    niepotrzebnie używasz k i TabWyrazow(k). Skoro robisz For Each Wyraz ... , to zamiast pisać TabWyrazow(k) pisz: Wyraz. Właśnie do tego służy ta pętla, żeby się potem nie odwoływać do tablicy po indeksie :)

    - Ja używam Excela 2003 z obsługą 255 kolumn, a Ty widzę masz wersję 2007, i wywala mi błąd gdyż funkcja importu rozbija na więcej niż 255 kolumn (np. 3 zapis w pliku mateo...). Jeżeli nie jest to przeszkodą, to OK. W przeciwnym razie musiałbyś pomyśleć o innej metodzie analizy danych (może wpisywać po 2-3 ruchy do każdej komórki?), a szkoda bo już masz spory kawałek kodu na tym oparty...

    - Przyczepił bym się jednak jeszcze do tego algorytmu :)
    Popatrz: każdy ruch zapisujesz w 3 komórkach (oznaczyłem je []), np. [1] [e4] [g6]
    Przypuszczam że 1 - to kolejny ruch, e4 - pozycja początkowa figury, g6 - pozycja końcowa. Czemu nie zapisać tego w w jednej komórce? np. [1 e4 g6], a może wprost: [1e4g6]
    Co więcej - ten fragment kodu analizy:
    Code:

    For k = 1 To j
       
        m = 0
       
        For l = 0 To i - 3
            If WsTmp.Cells(k, l + 23) = Debiut(l + 2) Then
                m = m + 1
            Else
                GoTo nextk
            End If
        Next l

    to masakra :) Przypuszczam że to on odpowiada za to, że program tak długo liczy.
    Kręcisz się po tych pętlach wielokrotnie, dokonujesz mnóstwa niepotrzebnych porównań.
    Popatrz, chcesz analizować otwarcia, czyli pierwszych x ruchów. Gdybyś zmienił formę zapisu i zapisał każde otwarcie jako ciąg znaków w jednej komórce albo - tylko jeden raz - przepisał je jako połączone wyrazy do tablicy stringów złączając je w zmiennej typu string znaczkiem &, wtedy de facto interesuje Cię tylko porównywanie x znaków od lewej strony.
    Żebyś mnie dobrze zrozumiał: jeżeli zapiszesz, np. w tablicy, partię jako pojedynczy ciąg znaków (zwykły for... po kolumnach i złączanie znaczkiem &):

    Code:
    tabl_partii(1) = "1 e4 g6 2 d4 Bg7 3 e5 h6 4 Nf3 e6 5 Bc4 c6 6 Nc3 Ne7 7 Be3 O-O 8 Qd2 g5 9 h4 Nf5 10 hxg5 Nxe3 11 Qxe3 hxg5 12 Nxg5 d5 13 Qh3 Re8"
    
    '....

    i tak dla wszystkich np. 572 rozegrań,
    a otwarcia zapiszesz analogicznie do drugiej tablicy, np. trójwymiarowej stringów:
    Code:

    Dim tabl_otwarc(1 To 2726, 1 to 3) as String
    tabl_otwarc(1, 1) = "A00"
    tabl_otwarc(1, 2) = "Polish Gambit, Anderssen's Opening"
    tabl_otwarc(1, 3)  = "1 a3 a5 2 b4"
    '.....

    to potem wykonujesz porównanie obu tablic tylko jeden raz, konkretnie: tablicy otwarc i x pierwszych znaków w tablicy partii, czyli:
    Code:

    max_arr = UBound(tabl_otwarc)
    for w = 1 to max_arr
       dlugosc = len(tabl_otwarc(w, 3))
       for each partia in tabl_partii
          if (len(partia) >= dlugosc) And (left(partia, dlugosc) = tabl_otwarc(w, 3)) then    'porównujesz tylko początek partii, może warto len(partia) wyliczyć raz i zapisać jako drugi wymiar tablicy?
              'tu robisz coś, np. zwiększasz o jeden jakiś licznik rozpoczętych tak partii
              '.....
          end if
       next partia
    next w


    Spróbuj wdrożyć tą ostatnią poprawkę a zobaczysz, że program przyspieszy niemiłosiernie ;)

    Pozdrawiam

    0
  • #27 06 Cze 2010 10:38
    mateo786
    Poziom 9  

    Wyjaśniam trochę kwestii.
    Korzystam z Office 2010. I raczej nie zależy mi na kompatybilności.

    Code:

    Popatrz: każdy ruch zapisujesz w 3 komórkach (oznaczyłem je []), np. [1] [e4] [g6]
    Przypuszczam że 1 - to kolejny ruch, e4 - pozycja początkowa figury, g6 - pozycja końcowa. Czemu nie zapisać tego w w jednej komórce? np. [1 e4 g6], a może wprost: [1e4g6]

    Niestety to są dwa ruchy, ruch białych i czarnych. Nie ma pozycji początkowej jest tylko pozycja końcowa. Ruch wynika z sytuacji na szachownicy. Musi być to rozdzielone gdyż czasami analizowany jest tylko pierwszy ruch. Lepszym rozwiązaniem będzie proponowane na końcu postu.

    Jak dla mnie to program już działa w miarę szybko, analiza jednego arkusza trwa około minuty. Czas jest więc już do przyjęcia.
    Code:

    For k = 1 To j
       
        m = 0
       
        For l = 0 To i - 3
            If WsTmp.Cells(k, l + 23) = Debiut(l + 2) Then
                m = m + 1
            Else
                GoTo nextk
            End If
        Next l


    Jeśli chodzi o podany fragment to zmienię nazwy zmiennych i , j. Bo właściwie to ilość kolumn albo wierszy. Powinno być to wtedy bardziej czytelne.

    Ostatnie proponowane rozwiązanie powinno znacznie przyspieszyć wykonywanie kodu. Zapisanie wszystkich ruchów w jednej komórce może być problemem ze względu na ilość znaków. Natomiast przepisanie znaków do jednej tablicy będzie chyba dobrym rozwiązaniem.

    Dzięki za sugestie. Po poprawieniu napiszę jakie rezultaty dały te zmiany.
    Pozdrawiam.

    0
  • #28 14 Cze 2010 19:06
    Grzybiarz
    Poziom 2  

    Moim zdaniem dobrym nawykiem jest pomijanie jakichkolwiek nazw zmiennych po next
    czyli
    zamiast "next i" piszemy next.

    0
  • #29 14 Cze 2010 19:16
    marcinj12
    Poziom 40  

    Grzybiarz napisał:
    Moim zdaniem dobrym nawykiem jest pomijanie jakichkolwiek nazw zmiennych po next
    czyli
    zamiast "next i" piszemy next.
    Akurat z tym się nie zgodzę ze względu na czytelność kodu. Bardziej czytelne jest pisanie wg mnie "Next i", ponieważ jeden rzut oka na kod i od razu wiadomo jaką zmienną inkrementujemy. Widać to zwłaszcza przy kilku zagnieżdżonych For'ach oraz przy długim kodzie, gdzie łatwo ustalić koniec pętli Next <zmienna> właśnie...

    0