Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

[Excel] Potreban makro za selekciju i kopiranje celija

[es] :: Office :: Excel :: [Excel] Potreban makro za selekciju i kopiranje celija

[ Pregleda: 8333 | Odgovora: 7 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

maja1978

Član broj: 14505
Poruke: 3
*.medianis.net



Profil

icon [Excel] Potreban makro za selekciju i kopiranje celija30.09.2003. u 13:59 - pre 249 meseci
da li neko moze da mi napise macro koji ce recimo od trenutno aktivne celije da selektuje sledecih 5 celija u istom redu i to sve zajedno da iskopira 2 reda iznad..

i varijacija na temu...selekcija ostaje ista ali ispituje celije iznad aktivne i kada dodje do prazne kopira u red iznad nje...

unapred zahvalna...

[Ovu poruku je menjao Shadowed dana 03.05.2006. u 18:54 GMT+1]
 
Odgovor na temu

degojs

Član broj: 4716
Poruke: 5096



+51 Profil

icon Re: pomoc u vezi Excel-a30.09.2003. u 15:45 - pre 249 meseci
Generalno ovakve stvari se rade tako sto startujes snimanje macro-a (Tools -> Macro -> Record New Macro) i onda odradi posao rucno. Zaustavi snimanje i zatim isti taj makro otvori u editoru i vidi sta je tamo, malo prepravis i to je to.

Slucaj 1:
Code:

   ' selektujemo aktivnu celiju i 4 desno od nje
    ActiveCell.Range("A1:E1").Select 
    Selection.Copy
    
    ' pomeramo se 2 reda iznad i ujedno selektujemo 5 celija gde cemo pastovati
    ActiveCell.Offset(-2, 0).Range("A1").Select
    ActiveSheet.Paste

Slucaj 2:
Code:

Sub Macro2()
   ' selektujemo aktivnu celiju i 4 desno od nje
    ActiveCell.Range("A1:E1").Select 
    Selection.Copy
    
   ' pomeramo se u celiju iznad
    ActiveCell.Offset(-1, 0).Activate 

    While ActiveCell <> "" ' ako trenutna celija nije prazna..
     ActiveCell.Offset(-1, 0).Activate ' ..pomeri se u celiju iznad
    Wend

    ' dosli smo do prazne celije, pastujemo ovde
    ActiveCell.Range("A1").Select     
    ActiveSheet.Paste
End Sub


Ako ne treba da selektujes i trenutnu celiju na pocetku, nego 5 sledecih desno od nje, izmeni kod tamo gde se vrsi selekcija i copy ovako:
Code:

' pomeramo se desno iz aktivne celije i onda selektujemo 5 sledecih
ActiveCell.Offset(0, 1).Range("A1:E1").Select
Selection.Copy

Pozdrav
Commercial-Free !!!
 
Odgovor na temu

maja1978

Član broj: 14505
Poruke: 3
*.medianis.net



Profil

icon Re: pomoc u vezi Excel-a01.10.2003. u 09:35 - pre 249 meseci
hvala na odgovoru...prilagodila sam tvoj makoro i sve je ok...trenutno sam u
guzvi i nemam bas nesto vremena da proucavam VBA sintaksu pa mi je samo
potrebna polazna osnova da ja to nadogradim...

evo jos jednog problemcica...imam u jednom sheet-u neke sifre proizvoda, a u
drugom cenovni sa siframa, nazivima i cenama....kako da na osnovu sifre sa jednog
lista pretrazim drugi list i nadjem naziv tog proizvoda i cenu i da to ubacim u
prvi list pored vec postojece sifre...
 
Odgovor na temu

degojs

Član broj: 4716
Poruke: 5096



+51 Profil

icon Re: pomoc u vezi Excel-a08.10.2003. u 18:53 - pre 249 meseci
Pogledaj ovu temu dole. trebalo bi da je VLOOKUP odgovor na ono sto ti trebas. Ako nije onda moze makro da se napise, mada mi se cini da je dovoljno samo ubaciti VLOOKUP u potrebne celije.
http://www.elitesecurity.org/tema/31128

Radni listovi (worksheet) se u formulama referenciraju pomocu !. Npr. worksheet1!B29 i slicno tome. Dakle: imeLista!celija.
Commercial-Free !!!
 
Odgovor na temu

maja1978

Član broj: 14505
Poruke: 3
*.medianis.net



Profil

icon Re: pomoc u vezi Excel-a10.10.2003. u 13:59 - pre 249 meseci
probala sam sa vlookup-om ali ne radi skroz ok...kada se sortiraju sifre onda da ali meni su uredjene drugacije....
 
Odgovor na temu

degojs

Član broj: 4716
Poruke: 5096



+51 Profil

icon Re: pomoc u vezi Excel-a10.10.2003. u 23:01 - pre 249 meseci
Code:

Public Function GetValue(trazeno As Range)
    
    Dim j As Range
    Set j = Worksheets("Sheet2").Range("B9")  ' ovde se nalazi tabela koju pretrazujemo
    
    While j.Value <> trazeno.Value And j.Value <> ""
        Set j = j.Offset(1, 0)       ' pomeramo se nadole u sifrarniku, sledeca sifra..
    Wend

    If j.Value = "" Then  ' dosli smo do kraja sifrarnika tj. prve prazne celije
        GetValue = "#NOT FOUND ERROR#"
    Else
        Set j = j.Offset(0, 1)  ' uzimamo podatak desno od sifre (npr. "Milan")
        GetValue = j.Value
    End If
End Function

Dakle recimo da imas dva radna lista: Sheet1 i Sheet2.
Na Sheet2 se nalazi sledeca tabela (kolona levo su sifre, kolona desno imena):
Code:

WX10  Zika
1WX2  Pera
ER11  Mika

To je tabela u kojoj trazimo neku sifru (npr. "1WX2") i onda prepisujemo kolonu desno: "Pera".
Sifra WX10 se nalazi u celiji B9 (vidi gore u kodu ovo mora da se zna - gde pocinje pretraga sifrarnika!).

E sad, npr. na prvom listu ukucavamo sifre, a Excel automatski izbacuje imena u koloni pored nje. Celija sa prvom sifrom 1WX2 je celija A1, itd.
Code:

1WX2  =GetValue(A1)
WX10  =GetValue(A2)


U stvari, evo ti Excel fajl prikacen, funkcija se nalazi u Module1.
Na prvom listu kucas sifre u koloni A, a sifrarnik je na Sheet2 (u koji mozes da dodajes nove sifre, itd.).

Pozdrav

P.S.
Naravno, sifre ne moraju biti sortirane.
P.S. (2)
Makroi moraju da budu Enabled, naravno.
Commercial-Free !!!
Prikačeni fajlovi
 
Odgovor na temu

Dag
Moscow

Član broj: 11879
Poruke: 97
*.moscow.dial.rol.ru

Sajt: orwell.ru


Profil

icon Re: pomoc u vezi Excel-a17.10.2003. u 04:00 - pre 248 meseci
Sluchaj 1 i sluchaj 2

U principu to nema veze: i sluchaj 1 i sluchaj 2 idu zajedno. Samo:
a) treba da proveravash lokaciju (shta ako si na vrhu? error)
b) nikada ne treba shetati 'fizichki' (select itd.)

Evo ovo bi bilo otprilike to kako bi trebalo. Ne treba da select ceo range - samo select prvu celiju / cell i startuj macros.

Code:
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub CopyData()
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'---------------- Declare variables
Dim dataSource As Object, dataDestination As Object
Dim strTemp As String, strSource As String, strDestination As String
Dim i As Byte

'---------------- Skuvaj chaj
strTemp = ""
strSource = ""
strDestination = ""
i = 0

'---------------- Set Source range
Set dataSource = Application.ActiveWindow.ActiveCell

'---------------- Set Source range - proveri da li ima mesta da se ide na vrh
If Right(dataSource.Address, 2) <> "$2" And _
   Right(dataSource.Address, 2) <> "$1" Then
    Set dataDestination = dataSource.Offset(-2, 0)
Else
    '---------------- Nema mesta - End
    Beep
    MsgBox "Ne vredi... ne mozhe to tako.", vbCritical, "Error"
    End
End If

If dataDestination.Value <> "" Then
    While dataDestination.Value <> "" And _
    Right(dataDestination.Address, 2) <> "$1" ' Da nismo u prvom redu
        Set dataDestination = dataDestination.Offset(-1, 0)
    Wend
End If

If dataDestination.Value = "" Then
    For i = 1 To 5
        dataDestination.Offset(0, i - 1).Value = dataSource.Offset(0, i - 1).Value
    Next i
Else
    '---------------- Nije bilo praznog mesta sve do prvog reda - End
    Beep
    MsgBox "Ne vredi... nemash praznog mesta sve do vrha.", vbCritical, "Error"
    End
End If
    
'---------------- Create report - trim $'s from Source and Destination ranges
'---------------- Source range
For i = 2 To Len(dataSource.Address)
    strTemp = Mid(dataSource.Address, i, 1)
    If strTemp = "$" Then
        strTemp = ""
    Else
        strSource = strSource & strTemp
    End If
Next i
strSource = strSource & " : "
For i = 2 To Len(dataSource.Offset(0, 4).Address)
    strTemp = Mid(dataSource.Offset(0, 4).Address, i, 1)
    If strTemp = "$" Then
        strTemp = ""
    Else
        strSource = strSource & strTemp
    End If
Next i

'---------------- Destination range
For i = 2 To Len(dataDestination.Address)
    strTemp = Mid(dataDestination.Address, i, 1)
    If strTemp = "$" Then
        strTemp = ""
    Else
        strDestination = strDestination & strTemp
    End If
Next i
strDestination = strDestination & " : "
For i = 2 To Len(dataDestination.Offset(0, 4).Address)
    strTemp = Mid(dataDestination.Offset(0, 4).Address, i, 1)
    If strTemp = "$" Then
        strTemp = ""
    Else
        strDestination = strDestination & strTemp
    End If
Next i
    
'---------------- Done OK
MsgBox "Data from range " & strSource & vbNewLine & "copied to range " & strDestination, vbInformation, "Copy OK"

End Sub

 
Odgovor na temu

Boboje

Član broj: 13121
Poruke: 383
*.verat.net.



+2 Profil

icon Re: pomoc u vezi Excel-a20.06.2005. u 02:29 - pre 228 meseci
1.moze li mi neko reci kako da napravim makro koji ce selektovati samo parne ili neparne redove, tj. sta upisati u VB editoru pod range.

2. da li je moguce selektovati samo redove deljive odredjenim brojem, npr brojem 5
 
Odgovor na temu

[es] :: Office :: Excel :: [Excel] Potreban makro za selekciju i kopiranje celija

[ Pregleda: 8333 | Odgovora: 7 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.