Excel - makro
Witam
Zwracam sie na Forum z prośbą o pomoc w rozwiązaniu następującego problemu. Jak napisać 3 podobne do siebie makra , które realizowałyby takie zadanie :
1. Mam 2 arkusze. W pierwszym (Arkusz1) znajdują sie dane w następującej postaci: 4000 wierszy a w każdej po 190 danych liczbowych. W drugim arkuszu (Arkusz2) następują obliczenia danych z Arkusza1.
2. Pierwsze makro pobierać ma dane z Arkusz1 w układzie
- a1:gh1 (190 liczb) i wklejało by do Arkusza2 do komórek a1:gh1
- następnie pobiera dane Arkusz1 a2:gh2 i do Arkusz2 do a1:gh1 i znowu
pobiera a3:gh3 i Arkusza2 do a1:gh1, itd. Czyli pobiera dane z Arkusz1 o jeden wiersz w dół a wkleja w to samo miejsce w Arkuszu2. Pobieranie następowałoby w pętli tak długo, aż w komórce G12 Arkusza2 pojawi się liczba 157.
3. "Postój" ten potrzebny jest mi do wykonania obliczeń na skopiowanych danych. Gdy pierwsze makro stanęło na liczbie 157 to drugie makro ma kontynuować pobieranie danych do momentu, gdy w komórce G12 pojawi się liczba 158. I tutaj znów analizuję dane, z tą jednak różnicą, że po wykonaniu obliczeń ulega zmianie liczba w komórce G12 (teraz liczba ta waha się w granicach 1 do 15)
4. Trzecie makro ma pobierać dane z Arkusza1 ale w odwrotną stronę, czyli się cofa, czyli pobiera dane idąc jeden wiersz w górę do momentu, gdy w komórce G12 pojawi się liczba 157.
Podałem potrzebne mi makra w kolejności wykonywania działań. Do makr przypiszę przyciski (tyle mam nadzieję, że jeszcze potrafię). Dodam jeszcze, że w Arkuszu1 kolumna A zawiera numery wierszy (ale nie od 1 tylko od 500 do 4500)
z poważaniem
marek
Odpowiedzi: 1
Hej
Takie coś powinno działać pod warunkiem, że jeden cykl sprawdzania zrobisz w jednej sesji otwarcia pliku:
Dim wiersz As Integer
Dim nr_szukania As Byte
Sub szukaj()
If nr_szukania < 2 Then
For wiersz = wiersz + 1 To 4000
Range("Arkusz1!A" & wiersz & ":AG" & wiersz).Copy Range("Arkusz2!A1")
If Range("Arkusz2!G12") = 157 + nr_szukania Then
nr_szukania = nr_szukania + 1
Exit Sub
End If
Next wiersz
Else
For wiersz = wiersz - 1 To 1 Step -1
Range("Arkusz1!A" & wiersz & ":AG" & wiersz).Copy Range("Arkusz2!A1")
If Range("Arkusz2!G12") = 157 Then
nr_szukania = 0
wiersz = 0
Exit Sub
End If
Next wiersz
End If
If wiersz = 4001 Then
If nr_szukania = 0 Then MsgBox "Nie spełniony warunek 1"
If nr_szukania = 1 Then MsgBox "Nie spełniony warunek 2"
End If
If wiersz = 0 Then MsgBox "Nie spełniony warunek 3"
nr_szukania = 0
wiersz = 0
End Sub
Pozdrawiam
<p>Spóźnione ale szczere podziękowanie za makro.</p><p>marek</p>