chemiczne funkcje do excela

Function masa_czasteczkowa(a As Integer, b As Integer, d As Integer) As Integer

Dim c As Byte

Dim H As Byte

Dim O As Byte

c = 12

O = 16

H = 1

a = InputBox("podaj liczbę węgli", "ilość węgli w cząsteczce") ' to mogło być, a nawet lepiej, żeby było dopiero w procedurze - nadanie wartości argumentom

b = InputBox("podaj liczbę wodorów", "ilość wodorów w cząsteczce") 'j.w.

d = InputBox("podaj liczbę tlenów", "ilość tlenów w cząsteczce") 'j.w.

masa_czasteczkowa = (a * c) + (b * H) + (d * O)

End Function

Sub próba()

Dim a As Integer

Dim b As Integer

Dim d As Integer

MsgBox "masa cząsteczki wynosi " & masa_czasteczkowa(a, b, d) & "g/mol", vbInformation, "wynik"

End Sub

Function nwd(a As Integer, b As Integer) As Variant 'źle działa - proszę sprawdzić jaki jest wynik tej funkcji

a = InputBox("podaj pierwszą liczbę")

b = InputBox("podaj drugą liczbę")

Do Until a <> b 'wykonuje się aż a <> b a ma się wykonywać aż a = b....

If a > b Then

a = a - b

Else

b = b - a

End If

Loop

nwd = a

End Function

Sub sprawdz_2() 'tu wyświetla "expected array" o co chodzi?:-(

Dim a As Integer

Dim b As Integer

'Dim nwd As Integer nazwy funkcji nie deklarujemy!!

MsgBox (nwd(a, b))

End Sub

Function nwd_popr(a As Integer, b As Integer) As Variant 'działa poprawnie, zamieniłam warunek na While...Wend

a = InputBox("podaj pierwszą liczbę")

b = InputBox("podaj drugą liczbę")

While a <> b 'pętla się wykonuje gdy a <>b

If a > b Then

a = a - b

Else

b = b - a

End If

Wend

nwd_popr = a ' działa

End Function

Sub sprawdz_2_popr() 'teraz jest OK

Dim a As Integer

Dim b As Integer

MsgBox (nwd_popr(a, b))

End Sub

Function suma(zakres As Variant) As Integer

Dim komórka As Variant

suma = 0

Set zakres = Application.InputBox("podaj zakres", "zakres", , , , , , 8)

For Each komórka In zakres

If komórka.Font.Name = "Times New Roman" Then suma = suma + 1

End Function

Sub sprawdź_3()

Dim zakres As Variant

Dim komórka As Variant

MsgBox (suma(zakres))

End Sub

Function dzielnik(zakres As Variant) As Integer

Dim komórka As Variant

dzielnik = 0

Set zakres = Application.InputBox("podaj zakres", "zakres", , , , , , 8)

For Each komórka In zakres

If IsEmpty(komórka) = False And IsNumeric(komórka) = True Then If komórka.Value Mod 7 = 0 Then dzielnik = dzielnik + 1

End Function

Sub sprawdź_4() ' wygląda OK

Dim komórka As Variant

Dim zakres As Variant

MsgBox (dzielnik(zakres))

End Sub

Function stezenie(ms As Integer, mr As Integer) As Integer

ms = InputBox("podaj masę substancji", "masa substancji")

mr = InputBox("podaj masę roztworu", "masa substancji")

stezenie = (ms / mr) * 100

End Function

Sub sprawdź_6() 'OK chociaż przypisanie wartości argumentom powinno znależć się w procedurze Sub

Dim stężenie As Integer

Dim ms As Integer

Dim mr As Integer

MsgBox "stężenie roztworu wynosi " & stezenie(ms, mr) & "%", vbInformation, "wynik"

End Sub

Function stezenie_inaczej(ms As Integer, mr As Integer) As Integer

'ms = InputBox("podaj masę substancji", "masa substancji")

'mr = InputBox("podaj masę roztworu", "masa substancji")

stezenie_inaczej = (ms / mr) * 100

End Function

Sub sprawdź_6_inaczej()

Dim stężenie As Integer

Dim ms As Integer

Dim mr As Integer

ms = InputBox("podaj masę substancji", "masa substancji") 'wprowadzenie wartości argumentów u Pani było w funkcji

mr = InputBox("podaj masę roztworu", "masa substancji")

MsgBox "stężenie roztworu wynosi " & stezenie_inaczej(ms, mr) & "%", vbInformation, "wynik"

End Sub

' Obliczenie n-tego elementu ciągu Fibonaciego (GRATIS :-))

'(pierwszy wyraz 1, drugi 1, następny sumą 2 poprzednich

Function Fibo(n As Byte) As Long

If n = 1 Then

Fibo = 1

ElseIf n = 2 Then

Fibo = 1

Else

Fibo = Fibo(n - 1) + Fibo(n - 2)

End If

End Function

Option Explicit

Sub wprowadź_dane(a As Single, b As Single, c As Single)

a = InputBox("Podaj a:")

b = InputBox("Podaj b:")

c = InputBox("Podaj c:")

End Sub

Function delta(a As Single, b As Single, c As Single) As Single

delta = b ^ 2 - 4 * a * c

End Function

Sub liniowe(a As Single, b As Single, x)

If a = 0 Then

If b = 0 Then

x = "Równanie tożsamościowe"

Else

x = "Równanie sprzeczne"

End If

Else

x = -b / a

End If

End Sub

Sub równanie_kwadratowe()

Dim a As Single, b As Single, c As Single, d As Single, x

Call wprowadź_dane(a, b, c)

If a = 0 Then

Call liniowe(b, c)

Else

d = delta(a, b, c)

If d < 0 Then

x = "nie ma rozwiązań"

ElseIf d = 0 Then

x = -b / 2 * a

Else

x = "są dwa rozwiązania:" & Chr(10) & Chr(13) & _

"x1 = " & (-b - Sqr(d)) / (2 * a) & Chr(10) & Chr(13) & _

"x2 = " & (-b + Sqr(d)) / (2 * a)

End If

MsgBox (x)

End Sub

Sub sumowanko()

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

decyzja = vbYes

Do Until decyzja = vbNo

sum = 0

n = InputBox("Podaj n:")

For i = 1 To n

sum = sum + i

MsgBox ("sumowałeś: " & n & " liczby" & Chr(10) & Chr(13) & "wynik sumowania: " & sum)

decyzja = MsgBox("czy chcesz liczyć jeszcze raz? ", vbYesNo + vbInformation, "decyzja")

Loop

End Sub

Sub sumowanie_w_obszarze()

Dim zakres, komorka, sum As Single

Set zakres = Application.InputBox("Podaj zakres:", "Zakres", , , , , , 8)

For Each komorka In zakres

sum = sum + komorka.Value

MsgBox (sum)

End Sub

Option Explicit

Sub deklaracje()

Dim stan_konta As Currency

Dim liczba_grupy As Byte

Dim nazwiska_grupy As String

Dim masy_cząstek As Integer

Dim roczna_liczba_prac As Byte

Dim daty_urodzin_studentow As Date

Dim miejca_urodzin_studentów As String

End Sub

Sub sumowanie()

Dim x As Byte, y As Byte, sum As Byte

x = Range("a1").Value

y = InputBox("podaj a:")

sum = x + y

MsgBox (sum)

End Sub

Sub słówko()

Dim słowo As String * 5

słowo = InputBox("podaj słowo:")

MsgBox (słowo)

End Sub

Sub równanie_liniowe()

Dim a As Single, b As Single, x

a = InputBox("podaj a - współczynnik kierunkowej prostej")

b = InputBox("podaj b - współczynnik kierunkowej prostej")

If a = 0 Then

If b = 0 Then

x = "równanie tożsamościowe"

Else

x = " równanie sprzeczne"

End If

Else

x = -b / a

End If

MsgBox ("rozwiązanie równania liniowego dla: " & Chr(10) & Chr(13) & "a = " & a & Chr(10) & Chr(13) & "b = " & b & Chr(10) & Chr(13) & "x = " & x)

End Sub

Sub wczytywanko(a As Single, b As Single, c As Single)

a = InputBox("podaj a - ")

b = InputBox("podaj b - ")

c = InputBox("podaj c - ")

End Sub

Function delta(a As Single, b As Single, c As Single)

delta = b ^ 2 - 4 * a * c

End Function

Sub rów_liniowe()

Dim a As Single, b As Single, x

If a = 0 Then

If b = 0 Then

x = "równanie tożsamościowe"

Else

x = " równanie sprzeczne"

End If

Else

x = -b / a

End If

End Sub

Sub równanie_kwadratowe()

Dim a As Single, b As Single, c As Single, d As Single, x

Call wczytaj(a, b, c)

End Sub

Wyszukiwarka