Obliczanie delty równania kwadratowego
Sub delta()
Dim a As Double
Dim b As Double
Dim c As Double 'deklarowanie zmiennych
Dim delta As Double
a = InputBox("podaj a")
b = InputBox("podaj b")
c = InputBox("podaj c") 'inputboxy każą użytkownikowi podawać jakieś dane do okienka
If a <> 0 Then 'jeśli a nie równa się zero wtedy
delta = b ^ 2 - (4 * a * c) 'wyrażenie na deltę
MsgBox ("delta rowniania kwadratowego wynosi" & delta) 'msgboxy informują o wyniku
Else 'co jeśli nie
MsgBox ("wspolczynnik a nie może rownac sie 0!")
End If 'koniec if
End Sub
Liczenie delt i miejsc zerowych
Sub miejsca_zerowe()
Dim a As Double
Dim b As Double
Dim c As Double
Dim delta As Double
Dim x1 As Double
Dim x2 As Double
a = InputBox("podaj a")
b = InputBox("podaj b")
c = InputBox("podaj c")
If a <> 0 Then
delta = b ^ 2 - (4 * a * c) 'wyrażenie na deltę
MsgBox ("delta rowniania kwadratowego wynosi" & delta) 'msgboxy informują o wyniku
Else 'co jeśli nie
MsgBox ("wspolczynnik a nie może rownac sie 0!")
End If 'koniec if
If delta = 0 Then
x1 = -b / (2 * a)
MsgBox ("x1=x2 i jest równe" & x1)
End If
If delta > 0 Then
x1 = ((-b - Sqr(delta))) / (2 * a)
x2 = ((-b + Sqr(delta))) / (2 * a)
MsgBox ("miejsca zerowe to" & x1 & x2)
End If
If delta < 0 Then
MsgBox ("brak miejsc zerowych")
End If
End Sub
Suma liczb naturalnych do n
Sub dodawanie()
Dim n As Double
Dim i As Long
Dim suma As Long
suma = 0
n = InputBox("podaj n")
For i = 1 To n
suma = suma + i
Next i
MsgBox ("suma to" & suma)
End Sub
Sortowanie od największej do najmniejszej liczby w inputboxach
Sub sortowanie()
Dim a As Long
Dim b As Long
Dim c As Long
Dim t As Long
a = InputBox("podaj a")
b = InputBox("podaj b")
c = InputBox("podaj c")
If b > a Then
t = a
a = b
b = t
Else
End If
If c > a Then
t = a
a = c
c = t
Else
End If
If c > b Then
t = b
b = c
c = t
Else
End If
MsgBox (a & b & c)
End Sub
Sortowanie dwóch liczb od największej do najmniejszej
Sub sortowanie1()
Dim a As Long
Dim b As Long
Dim t As Long
a = InputBox("podaj a")
b = InputBox("podaj b")
If b > a Then
t = a
a = b
b = t
Else
End If
MsgBox (a & b)
End Sub
Jaka ocena z przedmiotu, podaje punkty z 3 kolosów
Sub oceny()
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim suma As Long
a = InputBox("podaj ilosc punktow z pierwszego kolokwium")
b = InputBox("podaj ilosc punktow z drugiego kolokwium")
c = InputBox("podaj ilosc punktow z trzeciego kolokwium")
d = InputBox("podaj ilosc punktow z czwartego kolokwium")
e = InputBox("podaj ilosc punktow z piatego kolokwium")
suma = a + b + c + d + e
MsgBox ("suma punktów to" & suma)
If 95 <= suma And suma <= 100 Then ' trzeba pisać and zamist & bo wtedy dopiero będzie koniunkcja
MsgBox ("twoja ocena to 5")
ElseIf 90 <= suma And suma < 95 Then 'elseif pozwala na podanie innego warunku
MsgBox ("twoja ocena to 4+")
ElseIf 75 <= suma And suma < 90 Then
MsgBox ("twoja ocena to 4")
ElseIf 65 <= suma And suma < 75 Then
MsgBox ("twoja ocena to 3+")
ElseIf 50 <= suma And suma < 65 Then
MsgBox ("twoja ocena to 3")
Else
MsgBox ("nie zaliczyles przedmiotu")
End If
End Sub
Ilość komórek w zaznaczonym wierszu
Sub ilosc_komorek()
Dim a As Long
Dim b As Long
Dim ilosc As Long
a = Selection.Rows.Count ' liczy ilość komórek w danym wierszu
b = Selection.Columns.Count 'liczy ilość komórek w danej kolumnie
ilosc = a * b
MsgBox ("ilosc komorek to" & ilosc)
End Sub
Jaka wartość w komórce F5
Sub wartosc_z_komorki()
Dim a As Long
a = Cells(5, 6).Value 'podaje wartość jaka jest przypisana komórce F5
MsgBox ("a to" & a)
End Sub
Wpisywanie podanej wartości do komórki
Sub do_komorki()
Dim a As Long
a = InputBox("podaj a") 'wpisuje wartość podaną przez użytkownika do komórki I8
Cells(8, 9).Value = a
End Sub
Gdzieś błąd w formule
Sub z_komorki_do_komorki()
Dim a As Long
a = Cells(1, 2).Value
Cells(1, 1).Value = a ' przypisuje wartość z komórki B2 do komórki A1
End Sub
W komórce b2 wpisuje podanego przeze mnie x
Sub x_w_komorce_x_x()
Dim x As Long
x = InputBox("podaj x")
Cells(x, x).Value = x
End Sub
Podaj dzielniki wpisanych do msgboxa liczb
Sub dzielniki()
Dim i As Long
Dim dzielniki As String
Dim n As Long
n = InputBox("Podaj n")
dzielniki = "dzielniki" & n & " to: 1" 'msgbox poda wtedy, że dzielniki n to 1
For i = 2 To n 'zaczyna się pętla
If n Mod i = 0 Then 'jeśli reszta z dzielenia liczby n przez liczbę i jest równa zero...
dzielniki = dzielniki & ", " & i '...to dzielniki liczby n to formuła "dzielniki" podana wyżej (czyli 1), wszystkie liczby, które znajdują się w tym " , " przedziale oraz liczba i
End If 'koniec formułu if
Next i 'koniec pętli
MsgBox (dzielniki)
End Sub
Option Explicit
= wpisuje w komórce wartość stałej gazowej
Function Stała_gazowa() As Single 'funkcja stała, bezparametrowa
Stała_gazowa = 8.314 'przypisanie wartości do nazwy funkcji
End Function
Numer pierwszego wyrazu ci ągu
Function Numer(eps As Double) As Integer
'Napisz kod funkcji obliczający numer pierwszego wyrazu ciągu 1/n^2, _
który jest mnniejszy od eps
Dim wyraz As Double 'zmienna do przechowywania kolejnych wyrazów ciągu
Do 'W pętli
Numer = Numer + 1 'generujemy kolejny numer wyrazu
wyraz = 1 / Numer ^ 2 'generujemy nowy wyraz
Loop Until wyraz < eps 'sprawdzamy warunek stopu
End Function
Liczenie największego wspólnego dzielnika, gdzieś jest błąd
'Napisz kod funkcji odnajdującej największy wspólny dzielnik liczb a i b
'Algorytm Euklidesa
Function Euklides(a As Integer, b As Integer) As Integer
Do Until a = b 'Dopóki liczby a i b nie zrównają się
If a > b Then 'gdy a > b
a = a - b 'to nowym a staje się a - b
Else 'a w przeciwnym razie
b = b - a 'nowym b staje się b - a
End If
Loop
Euklides = a 'przypisanie wyliczonej wartości do nazwy funkcji
End Function
Oblicza liczbe moli z podanego p, v, t
Function mole(p As Single, v As Single, T As Single) As Single
'napisz kod funkcji obliczającej liczbę moli z równania Clausiusa-Clapeyrona
Const R As Single = 8.314 ' R jest stałą, więc deklarujemy przez Const
mole = p * v / (R * T) ' wzór ogólnie znany
End Function
obliczanie moli jak wyżej, z wyskakiwaniem bledu
Function mole1(p As Single, v As Single, T As Single) ' deklaracja wartości jako Variant _
dopuszczamy pojawianie się innych danych niż liczby
'napisz kod funkcji obliczającej liczbę moli z równania Clausiusa-Clapeyrona
Const R As Single = 8.314 ' R jest stałą, więc deklarujemy przez Const
If p > 0 Then
If v > 0 Then
If T > 0 Then
mole1 = p * v / (R * T) ' wzór ogólnie znany
Else
mole1 = "niewłaściwa wartość temperatury"
End If
Else
mole1 = "niewłaściwa wartość objętości"
End If
Else
mole1 = "niewłaściwa wartość ciśnienia"
End If
End Function
Jak wyżej, z komunikatem o bledzie
' niestety, mogą zdarzyć się użytkownicy, którzy wskażą jako dane teksty, _
trzeba też się przed tym zabezpieczyć
Function mole2(p, v, T) ' deklaracje zmiennych i wartości jako Variant _
dopuszczamy pojawianie się innych danych niż liczby
'napisz kod funkcji obliczającej liczbę moli z równania Clausiusa-Clapeyrona
Const R As Single = 8.314 ' R jest stałą, więc deklarujemy przez Const
If IsNumeric(p) And IsNumeric(v) And IsNumeric(T) Then
If p > 0 Then
If v > 0 Then
If T > 0 Then
mole2 = p * v / (R * T) ' wzór ogólnie znany
Else
mole2 = "niewłaściwa wartość temperatury"
End If
Else
mole2 = "niewłaściwa wartość objętości"
End If
Else
mole2 = "niewłaściwa wartość ciśnienia"
End If
Else
mole2 = "podaj wartości liczbowe"
End If
End Function
n-ty wyraz ciągu fibon.
'wyznacz n-ty wyraz ciągu Fibonacciego
Function Fibo(n As Byte) As Long
' metoda rekurencyjna, wprost z definicji ciągu Fibonacciego:
If n = 1 Then
Fibo = 1 'pierwszy wyraz ciągu jest równy 1
ElseIf n = 2 Then
Fibo = 1 'drugi też jest równy 1
Else
Fibo = Fibo(n - 1) + Fibo(n - 2) 'wyraz n-ty jest równy _
sumie 2 wyrazów poprzedzających
End If
End Function
Jak wyżej
'wyznacz n-ty wyraz ciągu Fibonacciego
Function Fibo1(n As Byte) As Long
'metoda iteracyjna
Dim x As Byte, y As Byte, z As Byte, i As Byte
x = 1 'pierwszy wyraz ciągu
y = 1 'drugi wyraz ciągu
i = 2 'indeks ciągu - aktualnie mamy policzony 2 wyraz
Do Until i > n
z = x + y 'liczymy kolejny wyraz
x = y 'przesuwamy się w górę ciągu - nowym wyrazem pierwszym staje się dawny wyraz drugi
y = z 'nowym drugim - dawny trzeci
i = i + 1 'zwiększamy indeks ciągu
Loop
Fibo1 = x
End Function
Ile pustych komórek w podanym zakresie
Function komórki(zakres As Range) As Byte
Dim komora 'deklaracja zmiennej przechowującej stan komórki
For Each komora In zakres
If IsEmpty(komora) Then komórki = komórki + 1
Next
End Function
Prawda czy falsz, czy sa we wskazanym obszarze liczby podzielne przez 37
'Zapisz kod funkcji sprawdzającej, czy w zakresie, będącym jej argumentem, _
jest choć jedna liczba podzielna przez 37
Function Liczba37(zakres As Range) As Boolean
'Wartość funkcji deklarujemy jako Boolean - prawda, gdy liczba jest, fałsz - gdy nie ma
'Oczywiście możemy zadeklarować inaczej wartość funkcji, np.: String i jako _
rozwiązanie podać komunikat, lub Byte i prawda to 1 a fałsz to 0.
Dim komórka 'deklaracja zmiennej przechowującej stan komórki
Liczba37 = False 'początkowa wartość funkcji, jeśli nic nie znajdziemy - tak zostanie
For Each komórka In zakres 'przeglądamy zakres komórka po komórce
If komórka.Value Mod 37 = 0 Then 'jeśli znajdziemy liczbę podzielną przez 37
Liczba37 = True 'nadajemy funkcji wartość True
Exit Function 'i już nie szukamy dalej
End If
Next
End Function
Jak wyżej, unikanie błedów
'Niestety taki kod powoduje uznanie pustej komórki, jako komórki _
zawierającej liczbę podzielną przez 37, zaś komórka zawierająca tekst _
powoduje zgłoszenie błędu ARG. Poniżej kod ignorujący puste komórki _
i komórki zawierające tekst.
Function Liczba37a(zakres As Range) As Boolean
Dim komórka
Liczba37a = False
For Each komórka In zakres 'przeglądamy zakres komórka po komórce
If Not IsEmpty(komórka) Then 'jeśli komórka nie jest pusta
If IsNumeric(komórka) Then 'i jeśli jest w niej liczba, to
If komórka.Value Mod 37 = 0 Then 'jeśli znajdziemy liczbę podzielną przez 37
Liczba37a = True 'nadajemy funkcji wartość True
Exit Function 'i już nie szukamy dalej
End If
End If
End If
Next
End Function
'Funkcje macierzowe - w rezultacie działania zwracają macierz
Ile pustych komórek zawiera obszar
' wyznacz liczby komórek pustych, zawierających liczbę i zawierających tekst we wskazanym zakresie arkusza
Function komórki1(zakres As Range)
Dim kom(1 To 3) As Byte 'deklaracja wektora przechowującego liczby komórek każdego typu
Dim komora 'deklaracja zmiennej przechowującej stan komórki
For Each komora In zakres 'dla każdej komórki w zakresie
If IsEmpty(komora) Then 'jeśli komórka jest pusta
kom(1) = kom(1) + 1 'zwiększ o 1 licznik pustych - pierwszy element wektora
ElseIf IsNumeric(komora) Then 'jeśli w komórce jest wartość liczbowa
kom(2) = kom(2) + 1 'zwiększ o 1 licznik liczb - drugi element wektora
Else 'a wszystko pozostałe to teksty
kom(3) = kom(3) + 1 'zwiększ o 1 licznik tekstów - trzeci element wektora
End If
Next
komórki1 = kom 'przypisanie wektora do nazwy funkcji
End Function
Tworzenie macierzy poprzez pomnożenie przez stala
'Napisz kod funkcji do tworzenia macierzy będącej iloczynem macierzy i stałej
Function macierz_razy_stała(zakres As Range, a As Double)
Dim macierz() 'jeszcze nie znamy rozmiarów macierzy
Dim komórka, i As Byte, j As Byte, lw As Byte, lk As Byte
lw = zakres.Rows.Count 'tu poznajemy rozmiary macierzy
lk = zakres.Columns.Count
ReDim macierz(lw, lk) 'ponownie deklarujemy macierz ale już znamy jej rozmiar
For i = 1 To lw 'pętla zewnętrzna przemiata wiersze
For j = 1 To lk 'pętla wewnętrzna przemiata kolumny
macierz(i, j) = a * zakres(i, j) 'tworzymy element nowej macierzy
Next
Next
macierz_razy_stała = macierz 'przypisujemy nową macierz do nazwy funkcji
End Function