Średnia arytmetyczna liczb w wybranym zakresie

Sub Sr()

Dim i As Byte, j As Byte, nw As Byte, nk As Byte, Suma As Integer

nw = Selection.Row

nk = Selection.Column

Suma = 0

For i = 1 To Selection.Rows.Count

For j = 1 To Selection.Columns.Count

Suma = Suma + Cells(nw + i - 1, nk + j - 1).Value

Next

Next

MsgBox ("Średnia arytmetyczna = " & Suma / Selection.Cells.Count)

End Sub

Wypełnianie zaznaczonego obszaru jako macierz:

Sub macierz_10x10()

Dim x As Byte, y As Byte, nw As Byte, nk As Byte

Randomize

nw=ActiveCell.Row: nk = ActiveCell.Column

For x = 1 To 10

For y = 1 To 10

Cells(nw + x - 1, nk + y - 1).Value = Int(100 * RND + 1)

Next

Next

End Sub

Kończenie programu wtedy gdy wpiszę 0 do msgboxa

Sub a()

Dim x As Byte

petla: x = InputBox("Podaj liczbę:")

If x <> 0 Then

GoTo petla

Else

MsgBox ("Koniec programu!")

End If

End Sub

Wpisuje ile mam wierszy w zaznaczonym zakresie

Function przyklad(zakres As Variant) As String

Dim tablica As Range

If IsArray(zakres) Then

Set tablica = zakres

przyklad ="Liczba wierszy: " & tablica.rows.count

End If

End Function

Oblicza silnie z wpisanej liczby

Function silnik(n As Byte) As Long

'silnia metodą iteracji

Dim i As Byte

i = 1

silnik = 1

Do Until i > n

silnik = silnik * i

i = i + 1

Loop

End Function

To samo

Function silnik2(n As Byte) As Long

'silnia rekurencyjnie

If n = 0 Then

silnik2 = 1

Else

silnik2 = n * silnik2(n - 1)

End If

End Function

Obliczanie silni

Function siln(wartosc As Integer)

wartosc = wartosc - 1

If wartosc = 0 Then

siln = 1

Exit Function

End If

siln = (wartosc + 1) * siln(wartosc)

End Function

Function Ile_parzystych(zakres As Range) 'zadanie 3

Dim komorka, sum As Integer

Dim n As Long

n = 2

For Each komorka In zakres

If Not IsEmpty(komorka) Then

If IsNumeric(komorka) Then

If komorka.Value Mod n = 0 Then sum = sum + 1

Else

Ile_parzystych = "Liczba!"

Exit Function

End If

Else

Ile_parzystych = "Puste komorki!!"

Exit Function

End If

Next

Ile_parzystych = sum

End Function

*********

Sub losowe() 'zadanie 2

Dim n As Long

n = InputBox("Podaj n, z zakresu od 1 do 100")

Cells(ActiveCell.Row, ActiveCell.Column).Value = Int(Rnd * 100)

msg = MsgBox("Czy liczymy dalej?", vbQuestion + vbYesNo, "decyzja")

End Sub

Option Explicit

Sub silnia()

Dim n As Integer, iloczyn As Integer, i As Integer

n = InputBox("Podaj n:")

iloczyn = 1

For i = 1 To n

iloczyn = iloczyn * i

Next

MsgBox "Wynik mnożenia: " & iloczyn, vbInformation + vbOKOnly, "Informacja o wyniku"

End Sub

Sub sumowanie_naturalnych()

Dim n As Integer, Suma As Integer, i As Integer, decyzja As String

n = InputBox("Podaj n:")

Do

n = InputBox("Podaj n:")

Suma = 0

For i = 1 To n

Suma = Suma + i

Next

MsgBox "Wynik sumowania: " & Suma, vbInformation + vbOKOnly, "Informacja o wyniku"

decyzja = MsgBox("Czy chcesz liczyć dalej?", vbYesNoCancel + vbQuestion, "Pytanie")

Loop While decyzja = vbYes

End Sub

Sub suma_w_obszarze()

Dim i As Byte, j As Byte, nw As Byte, nk As Byte, Suma As Integer

nw = Selection.Row

nk = Selection.Column

Suma = 0

For i = 1 To Selection.Rows.Count

For j = 1 To Selection.Columns.Count

Suma = Suma + Cells(nw + i - 1, nk + j - 1).Value

Next

Next

'MsgBox ("Suma liczb = " & Suma)

Cells(nw + Selection.Rows.Count + 1, nk) = Suma

End Sub

Sub suma_w_obszarze_z_inputboxem()

Dim nw As Byte, nk As Byte, Suma As Integer, komorka, zakres As Range

Set zakres = Application.InputBox("Wprowadź zakres", "Zakres", , , , , , 8)

nw = zakres.Row

nk = zakres.Column

Suma = 0

For Each komorka In zakres

Suma = Suma + komorka

Next

Cells(nw + zakres.Rows.Count + 1, nk) = Suma End Sub

Sub wpisz_zero()

Dim nw As Byte, nk As Byte, i As Byte, x As Single

nw = ActiveCell.Row

nk = ActiveCell.Column

Do Until x = 0

x = InputBox("Podaj liczbę:")

Cells(nw + 1, nk) = x

i = i + 1

Loop Until x = 0

End Sub

Sub sumka()
Dim a1 As Byte
Dim a2 As Byte
Dim sum As Byte
a1 = Range("A1").Value ' wartość a1 jest pobierana z komórki A1
a2 = Range("B1").Value ' wartość a2 jest pobierana z komórki B1
sum = a1 + a2 ' obliczenie wartości zmiennej sum
Range("C1").Value = sum ' kopiowanie wartości zmiennej sum do komórki C1
End Sub

Sub sumka1()
Dim a1 As Byte
Dim a2 As Byte 'proszę zmieniać typ zadeklarowanych zmiennych i obserwować, co się dzieje
Dim sum As Byte

a1 = InputBox("Podaj wartość a1") ' wartość a1 jest pobierana za pomocą okna dialogowego InputBox
a2 = InputBox("Podaj wartość a2") ' wartość a2 jest pobierana za pomocą okna dialogowego InputBox
sum = a1 + a2 ' obliczenie wartości zmiennej sum
MsgBox (sum) ' wartość sum wyświetlona zostaje za pomocą okna dialogowego Message Box
' MsgBox "Obliczono sumę a1 i a2 = " & sum, vbInformation + vbYesNo, "SUMA"
End Sub

Sub silnik() 'iteracyjne obliczenie n!
Dim n As Byte, i As Byte, sil As Long
sil = 1 'początkowa wartość n!, wykorzystywana także gdy n=0
n = InputBox("Podaj n") ' wprowadzenie danej wejściowej
For i = 1 To n 'uruchomienie pętli For
sil = i * sil 'do wartości sil w każdym cyklu pętli domnażana jest kolejna liczba naturalna i
Next

MsgBox (n & "! = " & sil) 'wyświetlenie wyniku
End Sub

Sub sumapar() 'oblicanie sumy kolejnych liczb parzystych od m do n
Dim m As Integer, n As Integer, i As Integer, sum As Long

m = InputBox("Podaj m") ' wprowadzanie danych wejściowych
If m Mod 2 <> 0 Then ' jeśli n nie jest parzyste, to ...
MsgBox ("m musi być parzyste")
Else ' a w przeciwnym razie
n = InputBox("Podaj n")

For i = m To n Step 2 ' pętla ze skokiem 2
sum = sum + i
Next
MsgBox ("Suma liczb parzystych od " & m & " do " & n & " = " & sum)
End If
End Sub

Sub siedem() ' czy w zaznaczonym obszarze arkusza jest liczba podzielna przez 7
Dim komora ' zawartość komórki może być dowolnego typu, więc deklarujemy ją jako Variant
For Each komora In Selection 'pętla For ... Each
If komora.Value <> 0 Then 'Jeśli a nie jest zerem lub pustą komórką
If komora.Value Mod 7 = 0 Then 'Jeśli znajdujemy choć jedną liczbę podzielną przez 7
MsgBox ("Jest liczba podzielna przez 7") 'Wyświetlamy komunikat
Exit Sub 'i nie mamy już potrzeby szukać dalej, więc opuszczamy procedurę
End If 'szukamy dalej
End If
Next
MsgBox ("Nie ma liczb podzielnych przez 7")
End Sub

Sub pisz_siedem() 'odszukaj w zazn. obszarze liczby podzielne przez 7 i wypisz je pod tym obszarem
Dim komora, licznik As Byte
For Each komora In Selection
If komora.Value <> 0 Then
If komora.Value Mod 7 = 0 Then ' jeśli znaleziono liczbę podzielną przez 7
Cells(Selection.Row + Selection.Rows.Count, Selection.Column + licznik).Value = komora.Value 'wypisz ją pod obszarem
licznik = licznik + 1
End If
End If
Next
End Sub

Sub liczby() ' wprowadzanie liczb z InputBoxa do arkusza do momentu, gdy wpisze się zero
Dim licznik As Byte, liczba As Integer

Do 'otwieramy pętlę
liczba = InputBox("Podaj kolejną liczbę") 'wprowdzamy kolejną liczbę
Cells(ActiveCell.Row, ActiveCell.Column + licznik).Value = liczba 'wpisujemy liczbę do arkusza w wierszu od celi aktywnej
licznik = licznik + 1 'zwiększanie licznika pętli
Loop Until liczba = 0 ' warunek stopu

End Sub

Sub liczby1() ' wprowadzanie liczb z InputBoxa do arkusza do momentu, gdy wpisze się zero
'Jeśli zmienimy miejsce spradzenia warunku stopu program nie wypisze żadnej liczby - zastanów się dlaczego?
Dim licznik As Byte, liczba As Integer

Do Until liczba = 0 ' warunek stopu
liczba = InputBox("Podaj kolejną liczbę") 'wprowdzamy kolejną liczbę
Cells(ActiveCell.Row, ActiveCell.Column + licznik).Value = liczba 'wpisujemy liczbę do arkusza w wierszu od celi aktywnej
licznik = licznik + 1 'zwiększanie licznika pętli
Loop
End Sub

Sub powrót() 'oblicz wartość wielomianu w = x^3 - x^2 - 3 i zapytaj, czy kontynuować obliczenia
Dim msg As String, x As Integer

msg = vbYes 'domyślnie wciskamy przycisk TAK w MsgBox
Do Until msg = vbNo 'Pętla kręci się aż do mometu wciśnięcia przycisku NIE w MsgBoxie
x = InputBox("Podaj liczbę") 'wprowadź zmienną niezależną
msg = MsgBox("Wartość wielomianu = " & x ^ 3 - x ^ 2 - 3 & Chr(10) & Chr(13) & "Czy liczymy dalej?", _
vbQuestion + vbYesNo, "DECYZJA") 'wyliczenie wartości wielomianu i pytanie o kontynuację
Loop
MsgBox ("Koniec, dziękuję")
End Sub

'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

ElseIf n = 2 Then

Fibo = 1

Else

Fibo = Fibo(n - 1) + Fibo(n - 2) ' def: wyraz n-ty jest równy sumie 2 wyrazów poprzedzających

End If

End Function

'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

i = i + 1 'zwiększamy indeks ciągu

Loop

Fibo1 = x

End Function

' 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

If IsEmpty(komora) Then

kom(1) = kom(1) + 1

ElseIf IsNumeric(komora) Then

kom(2) = kom(2) + 1

Else

kom(3) = kom(3) + 1

End If

Next

komórki1 = kom

End Function

Zmienna typu Range odnosi się do obiektu stanowiącego zakres arkusza:

Function sumal(zakres As Range) As Integer

Dim komórka As Variant

sumal = 0

For Each komórka In zakres

sumal = komórka.Value + sumal

Next

End Function

’Funkcja spawdzająca, czy w zaznaczonych obszarach arkusza znajdują się liczby parzyste.

Function para(ParamArray zakresy()) As Boolean

Dim zakres, komórka

para = False

For Each zakres In zakresy()

For Each komórka In zakres

If komórka.value Mod 2 = 0 Then

para = True

Exit Function

End If

Next

Next

End Function

Sub PrzykładPętli()

Dim wiersz, kolumna As Integer

Range("A1", "J1").Interior.ColorIndex = 15

Range("A2", "A10").Interior.ColorIndex = 15

For wiersz = 1 To 10

For kolumna = 1 To 10

Cells(wiersz, kolumna) = wiersz * kolumna

Next kolumna

Next wiersz

End Sub

Sub poleHerona()
Dim a As Single, b As Single, c As Single, poleObw As Single, poleH As Single
a = InputBox("podaj a:")
b = InputBox("podaj b:")
c = InputBox("podaj c:")

If a > 0 And b > 0 And c > 0 Then
poleObw = (a + b + c) / 2
End If
MsgBox (poleObw)
poleH = Sqr(poleObw * (poleObw - a) * (poleObw - b) * (poleObw - c))
MsgBox (poleH)

End Sub