Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 63743 Skopiuj do schowka Znajdowanie największego pola prostokąta.
Autor Wiadomość
polaczek91 
Fan Excela


Posty: 66
Wysłany: 09-01-2019, 11:15   Znajdowanie największego pola prostokąta.

Witam, mam problem z makrem.
Mianowicie, chciałbym, aby użytkownik podawał jakąś długość linii oraz krok przesuwania. Na tej podstawie ustalić jaka długość linii pozwoli na uzyskanie największego pola prostokąta (wykluczając kwadrat)

Napisałem coś takiego, ale nie jest to dobrze niestety.

Kod:
Option Explicit
Private Sub CommandButton1_Click()
Dim dl, krok, max, a, pole As Integer
dl = TextBox1.Value
krok = TextBox2.Value
a = 0
pole = 0

Do Until 0.5 * dl > krok

    a = dl - krok
    pole = a * krok
    If pole > max Then max = pole
    dl = dl - krok
   
Loop

MsgBox ("Pole wynosi: " & pole & vbCrLf & _
"Boki prostokąta to: " & a & " i " & krok)


End Sub




Z góry dziękuję za wskazówki!
ID posta: 360068 Skopiuj do schowka
 
 
Maciej Gonet
Excel Expert


Pomógł: 1182 razy
Posty: 4043

Wysłany: 09-01-2019, 14:59   

Ale jaki to w ogóle ma mieć sens? Z tego co zrozumiałem, to uwzględniasz tylko dwa boki, ale robisz to dość dziwnie, bo zmniejszasz jeden bok dwukrotnie, a drugiego nie zmieniasz w ogóle. Ale zakładając, że kod jest poprawny, jakiego oczekujesz wyniku? Jeśli suma dwóch boków prostokąta jest stała, tzn. w tym przypadku wynosi 10, to największe pole ma kwadrat o boku 5. Jeśli wykluczysz kwadrat, to najbliższy będzie "prawie kwadrat" o bokach 5+krok i 5-krok. Jaki sens ma więc to całe przeszukiwanie?
ID posta: 360094 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 3
Pomógł: 3710 razy
Posty: 7388
Wysłany: 09-01-2019, 15:19   

A ja z innej beczki - nie wnikając w sensowność, bo oczywiście podzielam zdanie Macieja. Zapewne takie zadanie dostałeś w szkole i nie powiesz przecież nauczycielowi, że to zły pomysł :mrgreen: Wszak On by i tak odpowiedział, nie jest to zadanie przemysłowe, ma ono tylko pokzazać, czy umiesz zaprogramować pętlę w VBA.

To "nie jest to dobrze niestety" to prawdopodobnie błąd niezgodności typów (szkoda, że ograniczyłeś się do istotnej - że nie jest dobrze - ale nieprecyzyjnej informacji. Bo może np. zwracany jest zły wynik? to też "nie jest dobrze"). Albo chociaż nie zastosowałeś się do p.2.3 regulaminu - wtedy byśmy mieli szansę sami zobaczyć co nie jest dobrze.

Spróbujmy zatem "na sucho":
Zmienne dl, krok, max, a są typu Variant
dl i krok mają przypisane wartości przez textboxX.value. A ponieważ jak nazwa wskazuje Textbob zwraca tekst, to zmienne te zawierają łańcuchy tekstowe (string).

Czyli początek mógłby wyglądać (uwzględniłem potencjalne problemy z wpisywaniem w polskiej wersji liczb z kropkami jako separatorami dziesiętnymi):
Kod:

Dim dl As Double, krok As Double, maxpole As Double, a As Double, pole As Double
dl = CDbl(Replace(TextBox1.Value, ".", ","))
krok = CDbl(Replace(TextBox2.Value, ".", ","))

zmieniłem też nazwę jednej zmiennej, bo co prawda max nie jest zastrzeżone w VBA, ale nie warto nadawać nazw, które mogą byc błednie zinterpretowane (jako nazwa funkcji arkuszowej)


Potem też jest wg mnie błędnie. Powiedzmy, że użytkownik wpisał 10 i 0,01
sprawdzamy 0.5 * dl > krok
oczywiście 5>0,01 więc pętla ani razu się nie wykona. Trzeba zatem zmienić algorytm.

No i ostania sprawa - nawet gdyby pętla się wykonywała, to w pętli nie zmieniasz wartości kroku, a pole liczysz jako a*krok. Czyli zawsze sprawdzasz tylko bardzo "płaskie" prostokąty - o jednym boku równym wielkości wprowadzonej przez użytkownika jako krok.

Spróbuj skorzystać z tych wskazówej i zrobić sam. Jeśli nie wystarczy - czytaj niżej.










Jeśli zrozumiałem "główny pomysł" to pewnie mogło to wyglądać np. tak:

Kod:
Private Sub CommandButton1_Click()
Dim dl As Double, krok As Double, maxpole As Double, a As Double, b As Double
Dim pole As Double, najlepszea As Double, najlepszeb As Double

dl = CDbl(Replace(TextBox1.Value, ".", ","))
krok = CDbl(Replace(TextBox2.Value, ".", ","))
a = 0
b = dl
maxpole = 0

Do Until a >= 0.5 * dl
    pole = a * b
    If pole > maxpole Then
      maxpole = pole
      najlepszea = a
      najlepszeb = b
    End If
    a = a + krok
    b = dl - a
Loop

MsgBox ("Pole wynosi: " & maxpole & vbCrLf & _
"Boki prostokąta to: " & najlepszea & " i " & najlepszeb)

End Sub




Przy czym nie uzyskasz spodziewanego wyniku a = 4,99 i b = 5,01 ze wzgledu na sposób przechowywania ułamków w excelu. Temat był ileś-tam razy omawiany na forum więc zaproponuję tylko krótki test nie zwracający wbrew podejrzeniom zera :-P :
Kod:
msgbox 3*0.01 -0.03
_________________
Kaper Jej Królewskiej Mości :boss

Jestem leniwy, ale się staram
ID posta: 360096 Skopiuj do schowka
 
 
polaczek91 
Fan Excela


Posty: 66
Wysłany: 10-01-2019, 09:46   

@Maciej Gonet Zgadza się, ale to nie ja wymyślałem treść zadania, wiem, że powinienem uwzględnić podwójne wartości boków, skoro z danej długości mam zbudować prostokąt.

@Kaper Rzeczywiście, trochę źle podszedłem do sprawy i nie pokazałem gotowego pliku, a jedynie kod wkleiłem. Dziękuję mimo wszystko za okazaną pomoc i wyjaśnienie "na sucho" co mogło być tego przyczyną.
ID posta: 360173 Skopiuj do schowka
 
 
Waldek 
ExcelSpec


Pomógł: 106 razy
Posty: 504
Wysłany: 10-01-2019, 10:47   

polaczek91 napisał/a:
@Maciej Gonet Zgadza się, ale to nie ja wymyślałem treść zadania...
Może w tym czasie gdy była podawana treść zadania grałeś w cymbergaja? Zadanie jest bez sensu. Zadanie miało by sens gdyby chodziło np. o obliczenie największego pola powierzchni czworokąta gdy podamy długości czterech jego boków. Albo gdy trzeba podać długości trzech boków i ma znaleźć czwarty, taki by pole czworokąta było największe.
ID posta: 360178 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe