[es] - macro for find and copy prilagodba koda

jaskojsako
BIH

Član broj: 141632
Poruke: 224
109.175.99.*

+4 Profil

macro for find and copy prilagodba koda

^{06.08.2014. u 20:21 - pre 118 meseci}

Poz
ovaj kod mi odrađuje super kada unesem jedan datum za pretragu e sad bi mi trebalo
preurediti kod da mi odrađuje pretragu i kopiranje između dva datuma
ako ima voljni unaprijed hvala

Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount As Date
searchAmount = InputBox("Type in the amount to search for:")

Dim cell As Date
For Each cell In rangeToSearch
If cell = CLng(searchAmount) Then
Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy
Sheets(2).Rows( _
Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 & _
":" & _
Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 _
).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next
Application.ScreenUpdating = True

_{[Ovu poruku je menjao jaskojsako dana 06.08.2014. u 23:11 GMT+1]}

Jasmin

Odgovor na temu

FOX028
Visoka tehnicka skola strukovnih studija
Kosovska Mitrovica

Član broj: 258986
Poruke: 850

Sajt: https://www.zile028.com

+49 Profil

Re: macro for find and copy prilagodba koda

^{07.08.2014. u 06:58 - pre 118 meseci}

Prepravio sam ovaj tvoj kod, u komentarima sam ti napisao sta sam dodao a sta izmenio. Ovo bi trebalo da radi, ja nisam imao primer u kom bih mogao isprobati ali ti isprobaj u tvom primeru da li radi.

Code:
Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount1 As Date
Dim searchAmount2 As Date   'dodato
searchAmount1 = InputBox("Type in the amount 1 to search for:")
searchAmount2 = InputBox("Type in the amount 2 to search for:") 'dodato

Dim cell As Date
For Each cell In rangeToSearch
    If cell >= CLng(searchAmount1) And cell <= CLng(searchAmount2) Then 'izmenjeno
        Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy
        Sheets(2).Rows( _
        Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 & _
        ":" & _
        Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 _
        ).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next
Application.ScreenUpdating = True

[email protected]=

Odgovor na temu

jaskojsako
BIH

Član broj: 141632
Poruke: 224
31.176.138.*

+4 Profil

Re: macro for find and copy prilagodba koda

^{07.08.2014. u 08:48 - pre 118 meseci}

poz
hvala na odgovoru,ali prijavljuje grešku na ovoj liniji koda
For Each cell In rangeToSearch ( označi cell) a greška koju prijavljuje
for each control variable must be variant or object
a uopšte ne polazuje input box za unos datuma
poz

Jasmin

Odgovor na temu

jaskojsako
BIH

Član broj: 141632
Poruke: 224
92.36.193.*

+4 Profil

Re: macro for find and copy prilagodba koda

^{07.08.2014. u 13:56 - pre 118 meseci}

Riješeno
Hvala članu FOX028 tvoj kod radi treba samo dodati rcell

Jasmin

Odgovor na temu

FOX028
Visoka tehnicka skola strukovnih studija
Kosovska Mitrovica

Član broj: 258986
Poruke: 850

Sajt: https://www.zile028.com

+49 Profil

Re: macro for find and copy prilagodba koda

^{07.08.2014. u 15:55 - pre 118 meseci}

Evo malo uprošćenog koda
[code]Application.ScreenUpdating = False
Dim rangeToSearch As Range
Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row)

Dim searchAmount1 As Date
Dim searchAmount2 As Date 'dodato
searchAmount1 = InputBox("Type in the amount 1 to search for:")
searchAmount2 = InputBox("Type in the amount 2 to search for:") 'dodato

Dim cell As Range
Dim i As Integer
Dim Uslov As Boolean
i = 2
For Each cell In rangeToSearch
Uslov = cell.Value >= CLng(searchAmount1) And cell.Value <= CLng(searchAmount2)
If Uslov Then 'izmenjeno
Sheets(1).Rows(cell.Row).Copy
Sheets(2).Range("A" & i).PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, False, False
Application.CutCopyMode = False
i = i + 1
End If
Next

Application.ScreenUpdating = True
[\code]

[email protected]=

Odgovor na temu

jaskojsako
BIH

Član broj: 141632
Poruke: 224
109.175.99.*

+4 Profil

Re: macro for find and copy prilagodba koda

^{04.07.2016. u 22:41 - pre 95 meseci}

Moze li ovom kodu da osim datuma od-do što je OK
da se doda treci uslov i četvrti uslov za pretragu

Sada pretražuje Range ("C" )za datum i to je OK
a kako dodati treci uslov da vrši pretragu u Range (" D") ----( traži šifru 2 )
i četvrti uslov pretragu u Range (" F") -----( traži šifru broj 3)

_{[Ovu poruku je menjao jaskojsako dana 04.07.2016. u 23:58 GMT+1]}

Jasmin

Odgovor na temu