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

Poređenje podataka jedne kolone i kopiranje u drugi Sheet

[es] :: Office :: Excel :: Poređenje podataka jedne kolone i kopiranje u drugi Sheet

[ Pregleda: 2689 | Odgovora: 6 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

portic78
sekretar
Srednjoškolski centar

Član broj: 314256
Poruke: 4
*.teol.net.



Profil

icon Poređenje podataka jedne kolone i kopiranje u drugi Sheet23.04.2013. u 18:40 - pre 103 meseci
Dragi prijatelji,
Već se duže vrijeme mučim sa pokušajem kreiranja macro-a....
Trebao bih napraviti macro koji će raditi sljedeće: Imam 5 kolona: A, B, C, D i E. U koloni B imam podatke koji se ponavljaju (pr. 342222227, 546666998, 546666998, 546666998, 546666998, 546666998, 546666998, 546666998, 211134567,...). Potrebno je sve podatke koji se pojavljuju više od 5 puta u koloni B prekopirati u drugi Sheet zajedno sa svim podacima iz ćelija kolona A, C, D i E za pripadajući podatak.

Unaprijed zahvalan za svaku pomoć!
 
Odgovor na temu

Brodoplovac
Beograd

Član broj: 171299
Poruke: 829
*.aDSL.verat.net.



+163 Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet24.04.2013. u 06:54 - pre 103 meseci
To je možda moglo i formulama da se uradi. U svakom slučaju evo ti makro:
Code:
Option Explicit
Option Base 1

Sub subViseOdPet()
Dim lngBrojRedova As Long
Dim i As Long, j As Long, r As Long
Dim colKolekcija As New Collection
Dim arrMatrica()
Dim arrRezultat()

'prebrojavamo koliko imamo redova sa podacima
lngBrojRedova = WorksheetFunction.CountA(Worksheets("Sheet1").Range("A:A"))
'prebacujemo sve podatke u matricu
arrMatrica() = Worksheets("Sheet1").Range("A1:E" & lngBrojRedova).Value

'sve podatke iz prve kolone matrice stavljamo u kolekciju koristeći sam podatak kao ključ. Javiće se greške jer ključ
'mora biti jedinstven. Mi koristimo to svojstvo da izdvojimo jedinstvene podatke.
On Error Resume Next
For i = 1 To lngBrojRedova
    colKolekcija.Add Item:=arrMatrica(i, 1), Key:=CStr(arrMatrica(i, 1))
Next i
On Error GoTo 0

r = 1
For i = 1 To colKolekcija.Count
    'za svaki jedinstven podatak proveravamo da li se ponavlja više od 5 puta.
    If WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A1:A" & lngBrojRedova), colKolekcija.Item(i)) > 5 Then
        For j = 1 To lngBrojRedova
            'ako se ponavlja više od pet puta, svako ponavljanje takvog rezultata stavljamo u arrRezultat matricu.
            'ova matrica ima obrnute kolone i redove jer "Redim Preserve" komanda dozvoljava da menjamo samo poslednju dimenziju.
            If arrMatrica(j, 1) = colKolekcija.Item(i) Then
                ReDim Preserve arrRezultat(5, r)
                arrRezultat(1, r) = arrMatrica(j, 1)
                arrRezultat(2, r) = arrMatrica(j, 2)
                arrRezultat(3, r) = arrMatrica(j, 3)
                arrRezultat(4, r) = arrMatrica(j, 4)
                arrRezultat(5, r) = arrMatrica(j, 5)
                r = r + 1
            End If
        Next j
    End If
Next i

'da bismo vratili rezultat u tabelu moramo da aktiviramo Sheet2, da ga očistimo od starih rezuultata.
'posle toga samo ubacimo matricu arrRezultat u worksheet, ali je prvo transponujemo jer smo joj obrnuli kolone i redove.
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("A1").CurrentRegion.Clear
Worksheets("Sheet2").Range(Cells(1, 1), Cells(UBound(arrRezultat, 2), UBound(arrRezultat, 1))).Value = WorksheetFunction.Transpose(arrRezultat)

End Sub
Prikačeni fajlovi
 
Odgovor na temu

portic78
sekretar
Srednjoškolski centar

Član broj: 314256
Poruke: 4
*.teol.net.



Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet24.04.2013. u 19:48 - pre 103 meseci
Hvala ti puno na pomoći i brzom odgovoru!!!
To je ono što mi je potrebno.
Međutim, još uvijek prilagođavam macro svojoj tabeli, trebam da kopiram uz dobijene rezultate i naslove kolona u drugi sheet. Takođe, meni je kolona za koju radim kriterijum kolona B i iako promijenim parametre u macrou, i umjesto za A kako si ti definisao podesim za kolonu B, izbacuje grešku, a tvoj macro radi ako izbrišem kolonu A...

Puno pozdrava!
Prikačeni fajlovi
 
Odgovor na temu

Brodoplovac
Beograd

Član broj: 171299
Poruke: 829
*.aDSL.verat.net.



+163 Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet24.04.2013. u 20:08 - pre 103 meseci
Evo ga ispravljeno.
Prikačeni fajlovi
 
Odgovor na temu

portic78
sekretar
Srednjoškolski centar

Član broj: 314256
Poruke: 4
*.teol.net.



Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet24.04.2013. u 21:17 - pre 103 meseci
Hvala puno na pomoći!
Savršeno radi!

Pokušavam da skontam u čemu sam griješio. Pa sam postavio kriterijum za kolonu D i ne izbacuje mi uredno rezultate...U prilogu je moj primjer...ako nije problem za komentar....

Srdačan pozdrav!

[Ovu poruku je menjao portic78 dana 24.04.2013. u 23:27 GMT+1]
Prikačeni fajlovi
 
Odgovor na temu

Brodoplovac
Beograd

Član broj: 171299
Poruke: 829
*.aDSL.verat.net.



+163 Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet25.04.2013. u 05:59 - pre 103 meseci
U mom primeru postoji greška. Treba da na dnu procedure piše:
Worksheets("Sheet2").Range(Cells(2, 1), Cells(UBound(arrRezultat, 2) + 1, UBound(arrRezultat, 1))).Value = WorksheetFunction.Transpose(arrRezultat)

U prilogu je rešenje za kolonu D.
Prikačeni fajlovi
 
Odgovor na temu

portic78
sekretar
Srednjoškolski centar

Član broj: 314256
Poruke: 4
*.teol.net.



Profil

icon Re: Poređenje podataka jedne kolone i kopiranje u drugi Sheet25.04.2013. u 07:12 - pre 103 meseci
Hvala ti puno!


Pozdrav
 
Odgovor na temu

[es] :: Office :: Excel :: Poređenje podataka jedne kolone i kopiranje u drugi Sheet

[ Pregleda: 2689 | Odgovora: 6 ] > FB > Twit

Postavi temu Odgovori

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