Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Sprawdż i skopiuj do kolejnego wiersza

jarekjarek · Exceloholic **Pomógł:** 1 raz Posty: 113

Witam!

Koledzy experci proszę o makro które sprawdzi każde pole w arkuszu Dane w kolumnie H ale rozpoczynając od H8 do końca i jeżeli w której z komórek kolumny H poczynając od H8 wartość jest większa niż 4 minuty i 59 sekund to skopiuje wartości z arkusza dane z komórki w kolumnie H tej która jest większa od 4 minuty i 59 sekund i komórki w kolumnie B w tym samym wierszu do arkusza opracowane w komórki w kolumnach A i B ale automatycznie do kolejnego wiersza.

Jak z tego wynika dane bedą sie zmieniać w arkuszu dane i tylko jak wartość bedzie wieksza od 4 minuty i 59 sekund to skopiuje kazdą wartość spełniającą warunek do kolejnego wiersza w arkuszu opracowane

Trebor · Excel Expert **Pomógł:** 1752 razy Posty: 4680

Tak na początek

Kod:

Sub szukaj()
Dim ostatnia As Long
Dim wiersz As Long
Dim gdzie As Long
gdzie = 1
With Sheets("Dane")
ostatnia = .Columns(8).Find(What:="*", After:=.Cells(8, 8), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For wiersz = 8 To ostatnia
If .Cells(wiersz, 8) > 3.46064814814815E-03 Then
gdzie = gdzie + 1
Sheets("Opracowane").Cells(gdzie, 1) = .Cells(wiersz, 8)
Sheets("Opracowane").Cells(gdzie, 2) = .Cells(wiersz, 2)
End If
Next wiersz
End With
End Sub

Pewnie należy jeszcze to czy tamto dorobić, ale zerknij czy początek jest właściwy.
Pozdrawiam

jarekjarek · Exceloholic **Pomógł:** 1 raz Posty: 113

Dziękuję sprawdzę jutro na swoim kompie nie mam Exdela tylko oppen office

Marian · Starszy Forumowicz **Pomógł:** 1 raz Posty: 47

A jak zmienić tę linię

Kod:

Sheets("Opracowane").Cells(gdzie, 2) = .Cells(wiersz, 2)

aby kopiowało cały wiersz z arkusza dane?

Trebor · Excel Expert **Pomógł:** 1752 razy Posty: 4680

Np. tak

Kod:

.Rows(wiersz).Copy Sheets("Opracowane").Cells(gdzie, 1)

Pozdrawiam

Marian · Starszy Forumowicz **Pomógł:** 1 raz Posty: 47

Dzięki, ja tę linię próbowałem zmienić ale jak to niech pozostanie... niedopowiedziane.

Pozdrawiam

jarekjarek · Exceloholic **Pomógł:** 1 raz Posty: 113

Witam działa to makro co mi napisałeś trochę je zmieniłem na swoje potrzeby

Kod:

Sub szukaj()
Dim ostatnia As Long
Dim wiersz As Long
Dim gdzie As Long
gdzie = 10
With Sheets("Dane")
ostatnia = .Columns(8).Find(What:="*", After:=.Cells(8, 8), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For wiersz = 8 To ostatnia
If .Cells(wiersz, 8) > 3.46064814814815E-03 Then
gdzie = gdzie + 1
Sheets("Opracowane").Cells(gdzie, 1) = .Cells(wiersz, 1)
Sheets("Opracowane").Cells(gdzie, 2) = .Cells(wiersz, 2)
Sheets("Opracowane").Cells(gdzie, 3) = .Cells(wiersz, 3)
Sheets("Opracowane").Cells(gdzie, 4) = .Cells(wiersz, 4)
Sheets("Opracowane").Cells(gdzie, 5) = .Cells(wiersz, 8)
End If
Next wiersz
End With
End Sub

a powiedz mi jeszcze co zmienić aby rozpoczynał sprawdzanie nie w komórce H8 a w H12 i zakończył sprawdzanie w komórce H164

Trebor · Excel Expert **Pomógł:** 1752 razy Posty: 4680

Usuń linię

Kod:

ostatnia = .Columns(8).Find(What:="*", After:=.Cells(8, 8), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

jest zbędna.
Zmień następną linię na

Kod:

For wiersz = 12 To 164

Pozdrawiam

jarekjarek · Exceloholic **Pomógł:** 1 raz Posty: 113

Dziękuję

francuz gt · Wysłany: 10-04-2007, 07:12

Siemka Treborku!
Faktycznie
Kod:

ostatnia = .Columns(8).Find(What:="*", After:=.Cells(8, 8), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
- ten kod można całkowicie usunąć, gdyż jest niepotrzebny.
A wracając do mojego pytania skierowanego do Ciebie osobiście to podejżewam, że trzeba dodać (tylko co i z jakimi dod. znakami) aby sprawdzał nie tylko z kolumny 8 ale i z 6 ?
Pozdróweczka
Grzegorz T
FRANCUZ-GT

Tajan · **Pomógł:** 5252 razy Posty: 11450

Jeżeli chcesz sprawdzać tylko niektóre kolumny, to możesz to zrobić np takim kodem:

Kod:

For kol = 12 To 141
Select Case kol
Case 12 To 19, 74 To 80, 105 To 141
For wiersz = 1 To 100
If Cells(wiersz, kol) = "" Then
Cells(wiersz, kol) = kol
End If
Next
End Select
Next

który pozwoli Ci sprawdzić wiersze 1-100 w kolumnach 12 - 19; 74 - 80; 105 - 141.
Ale nie wiem, czy o to chodziło :-)