Na wzniesieniu stoi wieża, na szczycie której montujemy czujnik zbierający informację o prędkości i kierunku wiatru. Chcemy wiedzieć, czy opłaca się zamontować prawdziwe „śmigło” i produkować prąd. Program WIATROMIERZ umożliwia wczytanie danych z czujnika, pokazanie na wykresach tzw. „wietrzności” i wyliczenie mocy wyprodukowanej przez domniemaną turbinę. Niewiele ponad 100 wierszy kodu, a zysk może być ogromny, choć okazuje się, że bardzo trudno znaleźć górkę, na której wieje długo i stabilnie.

Dane w urządzeniu pomiarowym zgrupowane są w tabeli zawierającej czasy prędkości i kierunki mierzonych wiatrów: 

Kod źródłowy programu poniżej, obliczeń w komórkach prawie żadnych.

mgr inż. Wacław Libront

Sub WstawDAT()
  'otwórz okienko
  ścieżka = Application.GetOpenFilename("pliki DAT (*.DAT), *.DAT", , "Znajdź plik wiatromierza i otwórz go")
  plikDAT = Dir(ścieżka) 'wydzielić sam plik
  p = InStr(plikDAT, ".")
  plik = Left(plikDAT, p - 1)
  
  'wczytaj
  Workbooks.OpenText Filename:= _
     ścieżka, Origin:=852, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
     xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
     Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
     Array(2, 1)), TrailingMinusNumbers:=True
  
  'przeniesienie do głównego
  Sheets(plik).Select
  Sheets(plik).Move After:=Workbooks("wiatromierz.xls").Sheets(2)
  Columns("A:A").ColumnWidth = 17.43
  
  'data początku i końca
  dataOD = Cells(3, 1)
  wiersz = 2
  Do
    wiersz = wiersz + 1
  Loop Until Cells(wiersz, 1) = ""
  dataDO = Cells(wiersz - 1, 1)
  
  'wpisać dane wczytanego pliku
  Worksheets("obsługa").Select
  wiersz = 1
  Do
    wiersz = wiersz + 1
  Loop Until Cells(wiersz, 13) = ""
  Cells(wiersz, 13) = plik
  Cells(wiersz, 14) = dataOD
  Cells(wiersz, 15) = dataDO
End Sub



Function SzukajDatę(arkusz, data As Variant) As Variant
  wiersz = 0
  koniec = False
  Do
    wiersz = wiersz + 1
    d = Worksheets(arkusz).Cells(wiersz, 1)
    'a gdy przeleci i nie znajdzie
    If Worksheets(arkusz).Cells(wiersz, 1) = "" Then
      MsgBox "nie ma takiej daty rozpoczęcia"
      wiersz = 1
      Exit Do
    End If
  Loop Until d >= data 'ta lub pierwsza następna
  SzukajDatę = wiersz
End Function


' dane są w jednym pliku - cały rok
' na razie ręcznie można kopiować i wklejać

Sub WyliczMOC()
On Error GoTo błąd
  dataOD = Worksheets("obsługa").Range("E4")
  dataDO = Worksheets("obsługa").Range("E5")
  rokOD = Year(dataOD)
  rokDO = Year(dataDO)
  If rokOD <> rokDO Then
    MsgBox "na razie potrafię liczyć tylko w JEDNYM ROKU"
    Exit Sub 'żeby zrobiło błąd
  End If
  
  rok = Trim(Str(rokOD))
  'a teraz wyszukaj konkretny dzień
  wiersz = SzukajDatę(rok, dataOD)
  'tutaj jest dataOD
  'na wszelki wypadek pobieramy bo może być inna
  dataOD = Worksheets(rok).Cells(wiersz, 1)
  wierszOD = wiersz
  wiersz = SzukajDatę(rok, dataDO)
  'na wszelki wypadek pobieramy bo może być inna
  dataDO = Worksheets(rok).Cells(wiersz, 1)
  wierszDO = wiersz
  
  If wierszOD > wierszDO Then
    MsgBox "coś z datami jest nie tak"
    Exit Sub
  End If
  
  Worksheets("obsługa").Range("E4") = dataOD
  Worksheets("obsługa").Range("E5") = dataDO
    
  'i teraz wreszcie można liczyć
  CzyśćObliczenia
  'róża przepisana
  For w = 4 To 19
    Worksheets("obliczenia").Cells(w, 5) = Worksheets("obsługa").Cells(w, 3)
  Next w
  
  moc = 0
  For wiersz = wierszOD To wierszDO
    prędkość = Worksheets(rok).Cells(wiersz, 2)
    Worksheets("obsługa").Range("Q1") = prędkość
    data = Worksheets(rok).Cells(wiersz, 1)
    Worksheets("obsługa").Range("E6") = data
    
    'przepisać do obliczenia
    d = Worksheets(rok).Cells(wiersz, 1)
    v = Worksheets(rok).Cells(wiersz, 2)
    k = Worksheets(rok).Cells(wiersz, 5)
    Worksheets("obliczenia").Cells(wiersz - wierszOD + 1, 1) = d
    Worksheets("obliczenia").Cells(wiersz - wierszOD + 1, 2) = v
    Worksheets("obliczenia").Cells(wiersz - wierszOD + 1, 3) = k
    Worksheets("obsługa").Range("Q2") = Trim(k)
    
    Calculate
    
    'moc
    m = Worksheets("obsługa").Range("R1")
    moc = moc + m
    
    'kierunek
    wk = Worksheets("obsługa").Range("R2")
    Worksheets("obliczenia").Cells(wk + 3, 5) = k
    Worksheets("obliczenia").Cells(wk + 3, 6) = Worksheets("obliczenia").Cells(wk + 3, 6) + 1
    Worksheets("obliczenia").Cells(wk + 3, 7) = Worksheets("obliczenia").Cells(wk + 3, 7) + v
    
    
  Next wiersz
  
  Worksheets("obsługa").Range("E7") = moc
  Worksheets("obliczenia").Range("E22") = wiersz - 1
  
  Calculate
  'arkusz prędkość
  Sheets("prędkość").SeriesCollection(1).XValues = Worksheets("obliczenia").Range("E23").Text
  Sheets("prędkość").SeriesCollection(1).Values = Worksheets("obliczenia").Range("E24").Text
  
  Worksheets("obsługa").Select
Exit Sub
błąd:
  MsgBox "nie znaleziono arkusza " & Str(rokOD) & " - zmień datę"
  Worksheets("obsługa").Select
End Sub

Sub CzyśćObliczenia()
    Sheets("obliczenia").Select
    Columns("A:C").Select
    Selection.ClearContents
    Range("E4:G19").Select
    Selection.ClearContents
    Range("A1").Select
End Sub