 |
www.wsinf2011.fora.pl
wsinf
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
webkret
Administrator
Dołączył: 04 Lut 2012
Posty: 38
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
|
 Wysłany: Nie 18:43, 18 Mar 2012 Temat postu: laborki 4 |
|
|
| Kod: | | http://speedy.sh/vz3Xr/kopiowanie-komorki.xls |
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
 |
|
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Mikolaj
Dołączył: 07 Lut 2012
Posty: 16
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Bdg
|
| Wysłany: Pon 0:20, 19 Mar 2012 Temat postu: |
|
|
| Cytat: |
Dim x As Integer
Dim y As Integer
Dim x0, y0, granica, flaga5
Dim p( , i, max_skoki(65), licz_pola
Sub Main()
flaga5 = False
'[C3].Select
ile_pól = 1
liczba_pól = Application.InputBox(prompt:="Liczba pól ?", Default:="64", Type:=1)
Randomize Timer 'inicjalizacja generatora liczb losowych
licz_pola = 1 'przypisanie startowe
Range("C3:J10").ClearContents
x0 = Selection.Row
y0 = Selection.Column
bok = Sqr(liczba_pól)
granica = bok + 2
If x0 < 3 Or x0 > granica Or y0 < 3 Or y0 > granica Then 'pierwsze - startowe - usawienie selekcji musi być w obrębie planszy
MsgBox "Najpierw wyznacz komórkę na planszy szachownicy!"
End
End If
For ii = 1 To 2
skoki_konia
If licz_pola > ile_pól Then
ile_pól = licz_pola
kk = kk + 1
End If
Next ii
MsgBox "Koń był na " & ile_pól & " polach"
End Sub
Sub skoki_konia()
Selection = "O"
i = 1
Do
flaga = True 'startowe ustawienie zmiennej logicznej na prawda
'Row - wiersz Column - kolumna
x = Selection.Offset(1, 2).Row 'praesunięcie 1 wiersz w dół, 2 kolumny w prawo
y = Selection.Offset(1, 2).Column
Call czy_w_planszy(x, y) 'Call - wywołanie procedury "czy_w_planszy" z parametrami x , y
x = Selection.Offset(2, 1).Row 'praesunięcie 2 wiersze w dół, 1 kolumna w prawo
y = Selection.Offset(2, 1).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(2, -1).Row 'praesunięcie 2 wiersze w dół, 1 kolumna w lewo
y = Selection.Offset(2, -1).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(1, -2).Row 'itp.
y = Selection.Offset(1, -2).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(-1, -2).Row
y = Selection.Offset(-1, -2).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(-2, -1).Row
y = Selection.Offset(-2, -1).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(-2, 1).Row
y = Selection.Offset(-2, 1).Column
Call czy_w_planszy(x, y)
'
x = Selection.Offset(-1, 2).Row
y = Selection.Offset(-1, 2).Column
Call czy_w_planszy(x, y)
los1 = Int((8 * Rnd)) ' + 1) ' Generuje liczbę losową w zakresie od 0 do 7.
Debug.Print los1 'wydrukowanie zmiennej los1 do Debug-era
If los1 > 0 Then 'ominięcie przesunięcia gdy los1 = 0
For tt = 1 To los1 'pętla ozmiennej (losowej) długości
Call przesunięcie 'wielokrotne (los1-razy) wywołanie procedury
Next
End If
For k = 1 To 8 'czytanie zawsze od 1-szej pozycji tablicy p(k) dla k=1, ale ta pozycja może mić
If p(k) <> Empty Then 'inną parę współrzędnych po przesunięciu los1-razy (normalnie od pole1)
'ale po przesunięciu np. los=2 sprawdzanie zacznie sie od pole3
x1 = Val(Left(p(k), 2)) 'czytanie zawsze od 1-szej pozycji tablicy p(k) dla k=1 dwa znaki z lewej strony
y1 = Val(Mid(p(k), 4, 2)) 'czytanie zawsze od 1-szej pozycji tablicy p(k) dla k=1 dwa znaki od pozycji 4
'Debug.Print x1 & " " & y1
If Cells(x1, y1) = Empty Then 'jeżeli pierwsza wolna komórka (offset(....))
If [L8].Value = True Then
Call opóźnienie(1.5) 'wywołanie procedury(z parametrem) opóźniającej ( w tym przypadku o 1.5 sek) następny krok
End If
Cells(x1, y1).Select 'selekcja komórki
Selection = "X" & licz_pola + 1 'wpisanie cyfry 1 do wyselekcjonowanej komórki
licz_pola = licz_pola + 1 'dodatkowy licznik liczący ile razy (ile 1-nek) koń był w komórce
Selection.Characters(2, 2).Font.Subscript = True
flaga = False 'jeżeli koń ani razu nie skoczył (nie było 1-ki) zmienna logiczna pozostanie ustw. na prawda
Exit For 'jeżeli wcześniej znaleziona pusta komórka wówczas opuszczana jest pętla
End If 'nie ma sensu szukanie następnej pustej komórki
End If
Next
'Stop
i = 1 'ponowne ustawienie na wartość = 1
Erase p 'czyszczenie tablicy p()
If flaga = True Then 'jeżeli flaga = prawda to ...
Exit Do 'wyjście z nieokreślonej pętli Do - Loop
End If
Loop
End Sub
Sub czy_w_planszy(x, y) 'warunki poniżej dla planszy od 3 kolumny i 3 wiersza
If granica >= x And x > 2 And granica >= y And y > 2 Then 'sprawdzenie czy wyselekcjonowana komórka znajduje się w planszy
If x < 10 Then 'ponieważ 8 kolumna planszy ma numer wiersza 10
xx = Str("0" & x) 'ustawienie zmiennej xx jako stringu 'wymuszamy jednolity 5 znakowy format współrzednych arkusza
Else 'przykładowo x i y będzie zapisany '03 10' a nie '3 10"
xx = x '
End If
If y < 10 Then
yy = Str("0" & y) 'ustawienie zmiennej yy jako stringu
Else
yy = y
End If
p(i) = xx & " " & yy 'wpisanie do kazdej kolejnej pozycji tablicy współrzędnych x,y w jednolitym formacie 'XX YY'
End If
'Debug.Print i & " " & p(i)
i = i + 1
End Sub
''*************************************************
Sub przesunięcie()
tymczasowa = p(1) 'zapisanie 1-szej pozycji z tablicy do zmiennej tymczasowej
For s = 1 To 7
p(s) = p(s + 1) 'przepisanie 2-giej (następnej) pozycji tablicy do 1-szej (poprzedniej) pozycji w tablicy
Next 'aż cała tablica zostanie przepisana
p(s) = tymczasowa ' s po ostatnim next ustawia sie na 8, do pozycji 8-mej wpisana zostanie wartość tymczasowa czyli poprzednia - 1-sza.
End Sub 'koniec i powrót do miejsca z którego procedura została wywołana
Sub opóźnienie(op As Single)
'opóźnienie op sekund (min=0,01, max=300)
Beep
Dim pocz_czas As Variant
If op < 0.01 Or op > 300 Then op = 1 'ograniczenie od dołu i od góry
pocz_czas = Timer 'przypisanie momentu startowego
Do
DoEvents 'w pętli przekazanie sterowania do systemu operacyjnego
Loop Until Timer - pocz_czas >= op 'i sprawdzanie czy spełniony jest warunek
End Sub
|
Może ktoś coś z tego zrozumie[/quote]
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Ania
Dołączył: 05 Lut 2012
Posty: 8
Przeczytał: 0 tematów
Pomógł: 1 raz
Ostrzeżeń: 0/5
|
| Wysłany: Czw 21:29, 17 Maj 2012 Temat postu: |
|
|
Mam prośbę: czy możecie zeskanować zadanie z konikiem bo gdzieś zapodziałam 
Proszę!
Post został pochwalony 1 raz
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
webkret
Administrator
Dołączył: 04 Lut 2012
Posty: 38
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
|
| Wysłany: Pią 9:59, 25 Maj 2012 Temat postu: |
|
|
przyłączam sie do prośby Ani. tez gdzieś p[osiałem...
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Mikolaj
Dołączył: 07 Lut 2012
Posty: 16
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Bdg
|
| Wysłany: Pią 13:10, 25 Maj 2012 Temat postu: |
|
|
[link widoczny dla zalogowanych]
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
webkret
Administrator
Dołączył: 04 Lut 2012
Posty: 38
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
|
| Wysłany: Pią 23:24, 25 Maj 2012 Temat postu: |
|
|
dziekowac
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
|
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
|
fora.pl - załóż własne forum dyskusyjne za darmo
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Szukaj
Użytkownicy
Grupy
Galerie
Rejestracja
Zaloguj się, by sprawdzić wiadomości
Zaloguj
