Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Witam

Próbuję stworzyć coś takiego, nie wiem czy muszę skorzystać ze skryptu VBA czy wystarczy funkcja w Excellu. Niestety jak na razie nie wychodzi mi nic.

Mam dwa Akrusze - 1, 2 a w nich kolumny od A1:A100. Potrzebuję teraz je porównać - czyli Arkusz1A1 porównuję z Arkuszem2A1:A100, później Arkusz1A2 z Arkuszem2A1:A100 itd. Jeżeli któreś z wartości będą równe w tym momencie kopiuje do Akrusza3 wartość komórki z Arkusza2(kolumnaBwiersz w którym się znajduje). Tak do momentu gdy nie dojdziemy do komórki A100. Proszę o poradę jak tego dokonać. Mam nadzieję, że w miarę jasno wyjaśniłem problem. Poniżej przedstawiam jak chciałbym aby to wyglądało

Arkusz1 Arkusz2 Arkusz3
A1=1 A1=2 B=20 30, 30
A2=2 A2=1 B=30 20
A3=3 A3=10 B=20 20
A4=3 A4=1 B=30 20
A5=2 A5=3 B=20 20

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Z tego co zrozumiałam - wystarczy w arkuszu3 w komórce A1 wstawić:

JEŻELI(Arkusz1!A1=Arkusz2!A1;Arkusz2!B1;"")

i przeciągnąć funkcję aż do komórki A100.
Choć w przypadku, gdy wartości nie są równe - postawia puste pole. Skąd tam bierze się ta liczba 20, jeżeli nie są równe? Marzanna Szulta edytował(a) ten post dnia 15.04.13 o godzinie 16:54

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Pole A1 w arkuszu1 i pole A2 oraz A4 w arkuszu2 są równe dlatego kopiuje do Arkusza3 wartość 30 z pola B2 oraz B4 z arkusza2
To samo dotyczy pola A2 w akruszu1 oraz pola A1 w akruszu2. Pola są równe i kopiuje wartość z pola B1 w akruszu2.
itd
To co podałaś Marzanna nie jest poprawne. Najpierw pole A1 musi zostać porównane z polami A1:A100 arkusza2. W momencie gdy wartości są równe to kopiuje wartość tak jak powyżej opisałem.

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Ok, byłąm pewna, że chodzi o porównanie do tego samego wiersza, a nie do całej tabeli.
W takim razie spróbuj tak:

=JEŻELI(LUB(Arkusz1!A1=Arkusz2!A$1:A$100);Arkusz2!B1;"")

Formuła tablicowa, wiec zatwierdzana nie Enterem, a Control+Shift+Enter.
I też przeciągnij w dół.

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Funkcja działa ale nie do końca tak jakbym chciał.
W chwili obecnej jak któreś z pól z akrusza2 będzie równe polu z arkusza1 to kopiuje tylko jedną komórkę B (warunek spełniony). Ja potrzebuję aby z arkusza2 kopiowane były wszystkie pola spełniające warunek
Przypuszczam, że zwykłą funkcja się tego nie da zrobić, będzie potrzebna do tego pętla i skrypt w VBAMichał Bochniak edytował(a) ten post dnia 16.04.13 o godzinie 13:45

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Nie trzeba.

=JEŻELI(LUB(Arkusz1!A$1:A$100=Arkusz2!A$1:A$100);Arkusz2!B1;"")

i przeciągamy - czyli kopiujemy do kolejnych wierszy poniżej. W podobny sposób jak tu:
http://mojezmaganiainformatyczne.blox.pl/2010/02/Wypel...

Nie bez powodu komórki z zakresu nie mają adresu względnego.

Oczywiście cały czas - formuła tablicowa czyli Control+Shift+Enter. Widać to po tym, że formuła jest zamknięta w nawiasie klamrowym { }.

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Nadal to jeszcze nie jest to gdyż wartość B powinna być pobierana z wiersza gdzie jest spełniony warunek Ark1A1:A100=Ark2A1:A100, czyli np w wierszu Ark1A1=Ark2A87 i z tego 87 wiersza powinna zostać pobrana wartość kolumnyB. Jeśli warunek również jest spełniony w wierszu wierszu Ark1A1=Ark2A93 to B93 rownież zostaje pobrane. W tym wypadku dla komórki A1 mamy warunek spełniony dwa razyMichał Bochniak edytował(a) ten post dnia 16.04.13 o godzinie 16:05

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Michał B.:
warunek również jest spełniony w wierszu wierszu Ark1A1=Ark2A93 to B93 rownież zostaje pobrane. W tym wypadku dla komórki A1 mamy warunek spełniony dwa razy

Miałam kiedyś szefa, z którym na podobnej zasadzie nie mogłam się dogadać. Cóż, czasem tak bywa, że ludzie w ogóle się nie rozumieją. Najpierw porównywałam te same wiersze - okazało się, że wystarczy że jest zgodność w jednym miejscu, aby pobrać wszystko. Teraz okazuje się, że gdy np. A1 jest równe także A93 - to dodatkowo pobieramy co? B1 i B93?
Napisanie kodu takiej pętli to 10 minut, ale naprawdę nie mam pojęcia co z czym porównać.
Sorry, ale chyba się poddam.

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Naprawdę nie wiem jak to prosto wyjaśnić. Zrobię już to bardzo łopatologicznie.
Krok po kroku.
1
W akruszu1 komórka A1 porównywana jest z komórką A1:A100 arkusza A2. W momencie gdy wartość jest równa zostaje pobrana wartość kolumnyB w wierszu gdzie ta wartość jest równa. Czyli jeśli pole ark1A1=ark2A9 to z ark2B9 pobrana jest wartość i przekopiowana do pola w akr3. Sprawdzanie trwa nadal. Kolejna równa wartość wystąpiła w polu A59. W związku z tym z pola ark2B59 zostaje pobrana wartość i przekopiowana do arkusza3 jako drugi wpis.
2
W arkuszu1 komórka A2 zostaje w porównywana w ten sam sposób jak powyżej
I tak do momentu aż w ark1 nie dojdziemy do pola A100

Mam nadzieję, że teraz objaśniłem prosto.
pozdrawiam i proszę o pomoc

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Michał B.:
Mam nadzieję, że teraz objaśniłem prosto.

Mam nadzieję, że tym razem będzie dobrze. Kod makra:

Public Sub Szukaj_Kopuj()

Dim Komorka As Range

Dim Kom As Range

Dim Dopis As Range

Dim i As Integer

Dim k As Integer

Dim m As Integer

Dim Tabl()



Dim Szukam

Dim Ile

Dim Pozycja As Long

Set Dopis = Range("Arkusz3!A1")

i = -1

m = 0

For Each Komorka In Range("Arkusz1!A1:A100")

 Szukam = Komorka.Value

 If m = 0 Then

    m = m + 1

    ReDim Tabl(1 To m)

    Tabl(m) = Szukam

 Else

   If IsError(Application.Match(Szukam, Tabl(), 0)) Then

      m = m + 1

      ReDim Preserve Tabl(1 To m)

      Tabl(m) = Szukam

     Else

      GoTo Nast

    End If

  End If

 Ile = Application.CountIf(Range("Arkusz2!A1:A100"), Szukam)

 If Ile > 0 Then

    k = 0

    i = i + 1

    For Each Kom In Range("Arkusz2!A1:A100")

        If Kom.Value = Szukam Then

           k = k + 1

           Dopis.Offset(i, 0) = Szukam

           Dopis.Offset(i, k) = Kom.Offset(0, 1)

         End If

        If k = Ile Then Exit For

    Next Kom

  End If

Nast:

Next Komorka

End Sub

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Dziękuję bardzo Marzanna, super makro.
Przerobiłem sobie aby wynik wyświetlał mi się w kolumnie

Public Sub Szukaj_Kopuj()

Dim Komorka As Range

Dim Kom As Range

Dim Dopis As Range

Dim i As Integer

Dim k As Integer

Dim l As Integer

Dim m As Integer

Dim Tabl()



Dim Szukam

Dim Ile

Dim Pozycja As Long

Set Dopis = Range("Arkusz3!A1")

i = -1

l = -1

m = 0

For Each Komorka In Range("Arkusz1!A1:A100")

 Szukam = Komorka.Value

 If m = 0 Then

    m = m + 1

    ReDim Tabl(1 To m)

    Tabl(m) = Szukam

 Else

   If IsError(Application.Match(Szukam, Tabl(), 0)) Then

      m = m + 1

      ReDim Preserve Tabl(1 To m)

      Tabl(m) = Szukam

     Else

      GoTo Nast

    End If

  End If

 Ile = Application.CountIf(Range("Arkusz2!A1:A100"), Szukam)

 If Ile > 0 Then

    k = 0

    i = i + 1

    For Each Kom In Range("Arkusz2!A1:A100")

        If Kom.Value = Szukam Then

           k = k + 1

           l = l + 1

           Dopis.Offset(l, 0) = Szukam

           Dopis.Offset(l, 1) = Kom.Offset(0, 1)

         End If

        If k = Ile Then Exit For

    Next Kom

  End If

Nast:

Next Komorka



End Sub

Michał Bochniak edytował(a) ten post dnia 19.04.13 o godzinie 10:18

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Mam jeszcze jedno pytanie. W chwili obecnej kod sprawdza jak jest pierwsza napotkana wartość i szuka kolejnej. Niestety gdy w ark1 pojawia kolejna taka sama liczba nie bierze jej już pod uwagę. Jak to poprawić?

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Trzeba usunąć fragment omijający duplikaty. Nie mam czasu teraz tego sprawdzać, ale powinno to być coś w tym stylu:

Public Sub Szukaj_Kopuj()

Dim Komorka As Range

Dim Kom As Range

Dim Dopis As Range

Dim i As Integer

Dim k As Integer

Dim l As Integer

Dim m As Integer

Dim Tabl()



Dim Szukam

Dim Ile

Dim Pozycja As Long

Set Dopis = Range("Arkusz3!A1")

i = -1

l = -1

m = 0

For Each Komorka In Range("Arkusz1!A1:A100")

 Szukam = Komorka.Value

 If m = 0 Then

    m = m + 1

    ReDim Tabl(1 To m)

    Tabl(m) = Szukam

 Else

     m = m + 1

      ReDim Preserve Tabl(1 To m)

      Tabl(m) = Szukam

  End If

 Ile = Application.CountIf(Range("Arkusz2!A1:A100"), Szukam)

 If Ile > 0 Then

    k = 0

    i = i + 1

    For Each Kom In Range("Arkusz2!A1:A100")

        If Kom.Value = Szukam Then

           k = k + 1

           l = l + 1

           Dopis.Offset(l, 0) = Szukam

           Dopis.Offset(l, 1) = Kom.Offset(0, 1)

         End If

        If k = Ile Then Exit For

    Next Kom

  End If

Nast:

Next Komorka



End Sub 

Marzanna Szulta edytował(a) ten post dnia 19.04.13 o godzinie 11:30

Temat: [Excell, VBA] Kopiowanie zawartości, jeżeli

Public Sub Szukaj_Kopuj()





Dim tblWzorzec()

    tblWzorzec = Range("Arkusz1!A1:A100").Value

Dim tblPrzeszukiwana()

    tblPrzeszukiwana = Range("Arkusz2!A1:B100")

Dim tblWynikowa()

Dim i As Long, x As Long, y As Long



    For x = LBound(tblWzorzec) To UBound(tblWzorzec)

        For y = LBound(tblPrzeszukiwana) To UBound(tblPrzeszukiwana)

            If tblWzorzec(x, 1) = tblPrzeszukiwana(y, 1) Then

                ReDim Preserve tblWynikowa(i)

                tblWynikowa(i) = tblPrzeszukiwana(y, 2)

                i = i + 1

            End If

        Next

    Next



    Range("Arkusz3!A1").Resize(UBound(tblWynikowa) + 1) = Application.Transpose(tblWynikowa)





End Sub