[VBA] Makro licząca równanie kwadratowe

Pankos
Użytkownik
Użytkownik
Posty: 127
Rejestracja: 16 lut 2010, o 20:48
Płeć: Mężczyzna
Lokalizacja: Polska/Płock
Podziękował: 13 razy
Pomógł: 1 raz

[VBA] Makro licząca równanie kwadratowe

Post autor: Pankos »

Dzień dobry wszystkim,
mam problem z napisaniem makro liczącym równanie kwadratowe. Otóż, kod już posiadam, wszystko ładnie liczy, nawet w dziedzinie liczb zespolonych, ale prowadzącemu zachciało się, by to makro liczyło, np. 3 równania na raz. Nie mam pomysłu jak tego dokonać.

P.S Nie mogłem kodu wpisać w \(\displaystyle{ - nie wiem dlaczego.

[code]Sub równanie_kwadratowe()
Dim a As Double, b As Double, c As Double, delta As Double
a = Range("A1")
b = Range("B1")
c = Range("C1")
delta = b ^ 2 - 4 * a * c
If a = 0 Then
MsgBox "To nie jest równanie kwadratowe"
Exit Sub
End If
If delta < 0 Then
ActiveCell(4, 4) = "Rownanie zawiera pierwiastki w dziedzinie liczb zespolonych"
Range("A3") = (-b + Sqr(-delta)) / (2 * a)
Range("A4") = (-b - Sqr(-delta)) / (2 * a)
End If
If delta = 0 Then
ActiveCell(5, 4) = "Rownanie zawiera pierwiastek w dziedzinie liczb rzeczywistych"
Range("A3") = -b / (2 * a)
End If
If delta > 0 Then
ActiveCell(6, 4) = "Rownanie zawiera pierwiastki w dziedzinie liczb rzeczywistych"
Range("A3") = (-b + Sqr(delta)) / (2 * a)
Range("A4") = (-b - Sqr(delta)) / (2 * a)
End If
End Sub[/code]}\)
Ostatnio zmieniony 11 sty 2014, o 17:13 przez Afish, łącznie zmieniany 1 raz.
Powód: Poprawa wiadomości.
tomkoder
Użytkownik
Użytkownik
Posty: 75
Rejestracja: 8 gru 2013, o 12:20
Płeć: Mężczyzna
Lokalizacja: Warszawa
Pomógł: 19 razy

[VBA] Makro licząca równanie kwadratowe

Post autor: tomkoder »

Pankos pisze:P.S Nie mogłem kodu wpisać w tex - nie wiem dlaczego.
Ponieważ kod się wpisuje w znaczniki code a nie tex.

Co do problemu - nie powiedział Ci nic więcej jak to sobie wyobraża?
Jeśli zostawił Ci dowolność to bym przerobił trochę makro tak aby cały wiersz \(\displaystyle{ 1}\) przeznaczony tylko na równanie pierwsze, wiersz \(\displaystyle{ 2}\) na drugie i \(\displaystyle{ 3}\) na trzecie.
Wtedy pierwiastki równań będziesz mógł umieścić w kolumnie \(\displaystyle{ D}\) i \(\displaystyle{ E}\) a uwagi o istnieniu/nieistnieniu rozwiązań w kolumnie \(\displaystyle{ F}\).

Skoro makro zrobiłeś to taka zmiana na pewno nie sprawi Ci problemu.

Wtedy zostanie Ci zakodowanie aby najpierw rozwiązał równanie z wiersza \(\displaystyle{ 1}\) potem z wiersza \(\displaystyle{ 2}\) itd.

To można zrobić na trzy sposoby:
1.
Po prostu kopiujesz swój kod 3-krotnie - w każdym wystąpieniu zmieniać numery wiersza na którym będzie operował.

2.
Zrobić dodatkową funkcję która przyjmie jako parametry dane wejściowe a zwróci 3komórkowy zakres z rozwiązaniem.
Wtedy możesz w głównym makrze po prostu użyć 3-krotnie tę funkcję jakoś tak (pseudokod)

Kod: Zaznacz cały

range("D1:F1")=rozwiaz_rownanie(Range("A1"),Range("B1"),Range("C1")
range("D2:F2")=rozwiaz_rownanie(Range("A2"),Range("B2"),Range("C2")
3.
Najbardziej fikuśnie:
Zmodyfikować wersję 2 do rozwiązywania dowolnej ilości równań
Możesz do tego wykorzystać że:

Kod: Zaznacz cały

Range("A500") 
to to samo co

Kod: Zaznacz cały

Dim d As Integer  
d=500
Range("A" & d )
i zrobic coś takiego (pseudo-kod):

Kod: Zaznacz cały

d=1

while (Range("A" & d ) And Range("B" & d ) AndRange("B" & d )) nie puste
 {
 range("D" & d & ":F" & d)=rozwiaz_rownanie(Range("A" & d ),Range("B" & d ),Range("C" & d )
 d++
 }
To będzie działać tak że będzie rozwiązywać równania kolejnych wierszy w nieskonczoność do momentu aż natrafi na pusty wiersz (czyli taki w którym nie ma równania).

Żeby było profesjonalnie musiałbyś jeszcze dodać sprawdzenie na wypadek gdyby wszystkie wiersze w excelu miały równania - żeby \(\displaystyle{ d}\) nie wyszło poza zakres ilości wierszy i nie wykrzaczyło makra (to istotne w excelach starszych niż 2007 gdzie było tylko 65000 wierszy)
Zamiast sprawdzania możesz po prostu dodać warunek że wychodzi z pętli jak d>1000 i powiedzieć ze twoje makro służy do rozwiązywania DO 1000 równań

Jakbyś stosował metodę 3. to proponowałbym jeszcze zrobić tak aby funkcja licząca brała jako parametr tylko \(\displaystyle{ d}\) a dopiero w środku funkcji pobierałbyś wartość z odpowiedniej komórki - tak będzie ładniej wyglądać.
Pankos
Użytkownik
Użytkownik
Posty: 127
Rejestracja: 16 lut 2010, o 20:48
Płeć: Mężczyzna
Lokalizacja: Polska/Płock
Podziękował: 13 razy
Pomógł: 1 raz

[VBA] Makro licząca równanie kwadratowe

Post autor: Pankos »

tomkoder pisze:
Pankos pisze:P.S Nie mogłem kodu wpisać w tex - nie wiem dlaczego.
Ponieważ kod się wpisuje w znaczniki code a nie tex.

Co do problemu - nie powiedział Ci nic więcej jak to sobie wyobraża?
Jeśli zostawił Ci dowolność to bym przerobił trochę makro tak aby cały wiersz \(\displaystyle{ 1}\) przeznaczony tylko na równanie pierwsze, wiersz \(\displaystyle{ 2}\) na drugie i \(\displaystyle{ 3}\) na trzecie.
Wtedy pierwiastki równań będziesz mógł umieścić w kolumnie \(\displaystyle{ D}\) i \(\displaystyle{ E}\) a uwagi o istnieniu/nieistnieniu rozwiązań w kolumnie \(\displaystyle{ F}\).

Skoro makro zrobiłeś to taka zmiana na pewno nie sprawi Ci problemu.

Wtedy zostanie Ci zakodowanie aby najpierw rozwiązał równanie z wiersza \(\displaystyle{ 1}\) potem z wiersza \(\displaystyle{ 2}\) itd.

To można zrobić na trzy sposoby:
1.
Po prostu kopiujesz swój kod 3-krotnie - w każdym wystąpieniu zmieniać numery wiersza na którym będzie operował.

2.
Zrobić dodatkową funkcję która przyjmie jako parametry dane wejściowe a zwróci 3komórkowy zakres z rozwiązaniem.
Wtedy możesz w głównym makrze po prostu użyć 3-krotnie tę funkcję jakoś tak (pseudokod)

Kod: Zaznacz cały

range("D1:F1")=rozwiaz_rownanie(Range("A1"),Range("B1"),Range("C1")
range("D2:F2")=rozwiaz_rownanie(Range("A2"),Range("B2"),Range("C2")
3.
Najbardziej fikuśnie:
Zmodyfikować wersję 2 do rozwiązywania dowolnej ilości równań
Możesz do tego wykorzystać że:

Kod: Zaznacz cały

Range("A500") 
to to samo co

Kod: Zaznacz cały

Dim d As Integer  
d=500
Range("A" & d )
i zrobic coś takiego (pseudo-kod):

Kod: Zaznacz cały

d=1

while (Range("A" & d ) And Range("B" & d ) AndRange("B" & d )) nie puste
 {
 range("D" & d & ":F" & d)=rozwiaz_rownanie(Range("A" & d ),Range("B" & d ),Range("C" & d )
 d++
 }
To będzie działać tak że będzie rozwiązywać równania kolejnych wierszy w nieskonczoność do momentu aż natrafi na pusty wiersz (czyli taki w którym nie ma równania).

Żeby było profesjonalnie musiałbyś jeszcze dodać sprawdzenie na wypadek gdyby wszystkie wiersze w excelu miały równania - żeby \(\displaystyle{ d}\) nie wyszło poza zakres ilości wierszy i nie wykrzaczyło makra (to istotne w excelach starszych niż 2007 gdzie było tylko 65000 wierszy)
Zamiast sprawdzania możesz po prostu dodać warunek że wychodzi z pętli jak d>1000 i powiedzieć ze twoje makro służy do rozwiązywania DO 1000 równań

Jakbyś stosował metodę 3. to proponowałbym jeszcze zrobić tak aby funkcja licząca brała jako parametr tylko \(\displaystyle{ d}\) a dopiero w środku funkcji pobierałbyś wartość z odpowiedniej komórki - tak będzie ładniej wyglądać.
Najlepiej mi pasuje metoda 3. Mam po prostu kod metody 3 wstawić na końcu swojego kodu ?
tomkoder
Użytkownik
Użytkownik
Posty: 75
Rejestracja: 8 gru 2013, o 12:20
Płeć: Mężczyzna
Lokalizacja: Warszawa
Pomógł: 19 razy

[VBA] Makro licząca równanie kwadratowe

Post autor: tomkoder »

Pankos pisze: Najlepiej mi pasuje metoda 3. Mam po prostu kod metody 3 wstawić na końcu swojego kodu ?
No nie bardzo.
Po pierwsze ja nie napisałem kodu tylko pseudo-kod.
Po drugie w tym co sugerowałem trzeba jeszcze przerobić część twojego kodu na funkcję i dokonać kilku innych zmian.
ODPOWIEDZ