[es] - poredjenje dva sheeta

gogi100
Goran Ljubic

Član broj: 40722
Poruke: 1064
*.dynamic.isp.telekom.rs.

+3 Profil

^{17.08.2012. u 23:08 - pre 142 meseci}

imam dva sheet koji sadrze iste kolone npr ime i prezime i dugovanje. treba mi funkcija koja ce omoguciti da se uporede kolone A u oba sheeta i da ako vrednost ne postoji bude ubacena sa svojom vrednosti u koloni B

sheet 1
A B
ime i prezime duguje
pera peric 20000
mika mikic 3000
zora zoric 10000

sheet 2
A B
ime i prezime duguje
pera peric 20000
mika mikic 3000
jova jovic 10000

rezultujuca

sheet 1
pera peric 20000
mika mikic 3000
zora zoric 10000
jova jovic 10000

da li je ovo moguce sa funkcijom ili je potreban makro?

hvala

Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898

+66 Profil

Re: poredjenje dva sheeta

^{18.08.2012. u 17:10 - pre 142 meseci}

Citat:

gogi100:da li je ovo moguce sa funkcijom ili je potreban makro?

Malo brzinski ;)
Malo googlanja i nađe se ponešto.
O kopiranju jedinstvenih podataka ili Unique Data bilo je i na ES-u govora.
Probaj jednu od ovih makronaredbi prilagoditi sebi

Code:

Sub CopyUniqueFromMultipleSheets()
'kopira Unique podatke sa vise sheets i sortira u jednom sve zajedno
Dim WS As Worksheet, a, i As Long, b(), N As Long, t As Long, z As String
On Error Resume Next
Application.DisplayAlerts = False
Sheets("result").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "result"
N = 1: t = 2
ReDim b(1 To Rows.Count, 1 To ThisWorkbook.Sheets.Count + 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each WS In Worksheets
        If WS.Name <> "result" Then
            t = t + 1: b(1, t) = WS.Name
            a = WS.Range("a1").CurrentRegion.Resize(, 3).Value
            For i = 2 To UBound(a, 1)
                z = a(i, 1) & ";" & a(i, 2)
                If Not .exists(z) Then
                    N = N + 1: .Add z, N
                    b(N, 1) = a(i, 1): b(N, 2) = a(i, 2)
                End If
                b(.Item(z), t) = a(i, 3)
            Next
        End If
    Next
End With
Sheets("result").Range("a1").Resize(N, t).Value = b
End Sub

ili ovaj

Code:
Sub CopyUniqueMultipleSheets()
'copy unique data from multiple sheets
Dim j As Integer, r As Range, k As Integer
Application.DisplayAlerts = False
On Error GoTo proceed
Worksheets("result").Delete
proceed:
Worksheets.Add
ActiveSheet.Name = "result"
For j = 1 To Worksheets.Count
If Worksheets(j).Name <> "result" Then
With Worksheets(j)
Set r = Range(.Range("A2:B2"), .Cells(Rows.Count, "A").End(xlUp))
r.Copy Worksheets("result").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
End If
Next j
With Worksheets("result")
.Range("A1") = "HEADING"
Set r = Range(.Range("A1"), .Cells(Rows.Count, "A").End(xlUp))
r.AdvancedFilter xlFilterInPlace, , , True
End With
With Worksheets("result")
For k = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Rows(.Cells(k, 1).Row).Hidden = True Then
Cells(k, 1).EntireRow.Delete
End If
Next k
End With
Application.DisplayAlerts = True
End Sub

Prikačeni fajlovi

CopyUniqueFromMultipleSheets.xls - 49.5k

Odgovor na temu