VBA: Porównywanie i kopiowanie rekordów między arkuszami Excel

Question

Witam serdecznie! Właśnie zaczynam programowanie w VBA i mam problem. Chciałbym aby makro sprawdzało mi rekordy w np. kolumnie A w Arkuszu1 i porównywało czy taki rekord już istnieje tez w kolumnie A ale w Arkuszu2. Jeżeli się powtarza to kopiuje powtarzający się rekord do Arkusza3 w kolumnę,...

Dżyszla · Answer

a koniecznie makro? To można zwykłymi funkcjami zrealizować.

the_man · Answer

Może byc funkcjami , niekoniecznie makro ale chcialbym zeby bylo napisane pod excelem. A jaka masz propozycje i jak to zrobic?

Dżyszla · Answer

lookup lub w polskiej wersji: wyszukaj. Ponadto funkcja if (jeżeli). Więcej nic nie trzeba.

the_man · Answer

Tak jak wspomnialem jestem poczatkujacy w programowaniu. Moglbys mi pokazac jak to ma wygladac w kodzie programu. Dziekuje z gory

adamas_nt · Answer

Funkcja WYSZUKAJ zwróci wynik przybliżony, czyt. nie zawsze prawdziwy. Precyzyjniej działa funkcja WYSZUKAJ.PIONOWO. W Twoim przypadku formuła umieszczona w 'Arkusz3' powinna wyglądać tak:
WYSZUKAJ.PIONOWO(Arkusz1!A1;Arkusz2!A1;1;0)
Funkcja zwróci: 'ND' w przypadku niepasujących wartości. Można to zastąpić dowolnym tekstem stosując: JEŻELI i CZY.BŁĄD.
JEŻELI(CZY.BŁĄD(WYSZUKAJ.PIONOWO(Arkusz1!A1;Arkusz2!A1;1;0));"Dowolny tekst";WYSZUKAJ.PIONOWO(Arkusz1!A1;Arkusz2!A1;1;0))
W VBA porównanie można wykonać w pętli 'For-Next' z ilością kroków równą liczbie niepustych komórek w kolumnie 'A' arkusza 'Arkusz1'.

Dżyszla · Answer

Małe sprostowanie do poprzednika:
w VBA porównanie można wykonać za pomocą dwóch pętli (zagnieżdżonych) - każdą kom. z Arkusza1 należy porównać z każdą kom. Arkusza2. No chyba, że zastosujemy funkcje wyszukujące, ale raczej myślałem o najprostszym porównywaniu każdej z każdą.

adamas_nt · Answer

Wydaje mi się, że pętla zmieniająca tylko kryteria wyszukiwania w zakresie, który jest stały będzie działać szybciej. Podobnie jak funkcja WYSZUKAJ.PIONOWO. Tutaj wynik działania formuły:
=JEŻELI(CZY.BŁĄD(WYSZUKAJ.PIONOWO(Arkusz1!A1;Arkusz2!A$1:A$10;1;0));"Nie znaleziono: "&Arkusz1!A1&"";WYSZUKAJ.PIONOWO(Arkusz1!A1;Arkusz2!A$1:A$10;1;0))
VBA: Porównywanie i kopiowanie rekordów między arkuszami Excel

VBA: Porównywanie i kopiowanie rekordów między arkuszami Excel

Oczywiście nie wiemy dokładnie jaki mają format i jak poukładane są dane w arkuszu autora...

bezdura · Answer

witam

Ja mam podobny problem, z tym ze bardziej złożony.
mam dwa arkusze, jak ponizej:

VBA: Porównywanie i kopiowanie rekordów między arkuszami Excel

I teraz chodzi o to żeby zostały porównywane daty i sp w arkuszu1 z datami i sp w arkuszu2. Czyli zeby mi wskazał te daty które sie róznią w tych arkuszach dla tych samych wartosci sp (kolumna B) . Np w arkuszu 1 mam Sp12 i date 2009-12-02
natomiast w arkuszu2 dla tego samego Sp12 mam już inna date czyli 2009-12-03 to chciałbym aby w arkuszu3 wylistował mi te rózne daty dla tych samych Sp albo coś w tym stylu aby wiedział które daty sie zmieniły.

Z góry dzięki za pomoc

bezdura · Answer

czy może mi ktoś w temacie pomóc. Dostałem podpowiedż że można tutaj uzyć funkcji wyszukaj.pionowo ale nie wiem jak ja w tym wypadku zastosowac, gdyż ona fajnie działa dla dwóch kolumn a nie czterech. Obawiam sie ze tu trzeba jakieś makro napisać.

wojtekcz · Answer

Sub sprawdz() Dim identycznie As Boolean Const ark1 = arkusz1 Const ark2 = arkusz2 Const ark3 = arkusz3 w = 1 Do While Sheets(ark1).Cells(w, 2) If Format(Sheets(ark1).Cells(w, 2),

bezdura · Answer

no i wlasnie tu jest problem, że sp nie są w odpowiadajacych sobie komorkach tylko w róznych

wojtekcz · Answer

no dobra

sprawdź ten kod


'Option Base 1
Sub sprawdz()
Dim jest As Boolean
Dim TabData() As Date
Dim TabSp() As String
Dim w_pierwszy As Integer
Dim k As Integer
Dim kD As Integer
Dim kSp As Integer

Set ark1 = Sheets("arkusz1")
Set ark2 = Sheets("arkusz2")
Set ark3 = Sheets("arkusz3")



'******************************
w_pierwszy = 1 ' pierwszy wiersz na ark zawierający dane
kSp = 2 'oznacza kolumnę gdzie są wpisane sp. zmień na inna jeżeli potrzeba
kD = 1 ' 'oznacza kolumnę gdzie jest wpisana data. zmień na inna jeżeli potrzeba
'******************************
'z arkusza 2 pobieramy dane do tablic
w = w_pierwszy

'******************************
' pętla przez wszystkie dane sp na arkuszu2
' wszystkie te dane wpisujemy do tablic daty i sp
ark2.Select
Do While Cells(w, kSp) <> "" '
  If Not IsDate(Cells(w, kD)) Then GoTo nastepny
  ReDim Preserve TabData(w)
  ReDim Preserve TabSp(w)
    TabData(w) = Cells(w, kD)
    TabSp(w) = Cells(w, kSp)
nastepny:
w = w + 1
Loop
'*******************************


'********************************
' przechodzimy na ark1,  pobieramy kolejne sp i sprawdzamy z danymi w tablicach
w = w_pierwszy
ark1.Select
Do While Cells(w, 2) <> ""
 szukanesp = Cells(w, kSp)
 datadlasp = Cells(w, kD)
    '*******************************
    ' szukamy sp z arkusza1 z danymi w tablicy sprawdzając całą tablice sp
    For i = 1 To UBound(TabSp)
       If Format(Cells(w, kSp), "<") = Format(TabSp(i), "<") Then
            jest = True
             '**********************************
             'jeżeli znaleziono szukane sp to sprawdzamy daty na obu arkuszach
             If Cells(w, kD) = TabData(i) Then
                 ark3.Cells(w, 1) = "OK.    Dla sp = " & CStr(szukanesp) & "   daty są identyczne;  " & CStr(datadlasp)
                 Else
                 ark3.Cells(w, 1) = "Inne.   Dla sp = " & CStr(szukanesp) & "   daty są różne:  " & CStr(ark1.Name) & " jest " & CStr(datadlasp) & "; " & CStr(ark2.Name) & " jest " & CStr(TabData(i))
             End If
             '***********************************
        End If
        If jest Then Exit For
    Next i
    '********************************
jest = False ' zerujemy zmienną. zmienna jest tylko po to, by po znalezieniu sp nie przeszukiwać dalej tablicy
w = w + 1
Loop

End Sub

bezdura · Answer

jesteś wielki, Oczywiscie działa jak nalezy. Dzięki wielkie

Zastanawiam sie tylko czy dużym problemem byłoby zrobienie tak zeby nie zwracało wynik do arkusz3 tylko updatowało jeśli nie są daty identyczne w arkuszu1.Tzn przyjmujemy ze arkusz1 jest wyjsciowy i jezeli nam nie pasują daty z arkusza2 to zeby poprawiał z automatu arkuszu1 na teniepasujace z arkusza2 plus ewentualnie tylko te rózne odznaczał np na zielono w arkuszu1

wojtekcz · Answer

w tym miejscu po ELSE jest fragment kodu odpowiedzialnego za to co się stanie jezeli daty sa różne
fragment kodu:

Else
ark3.Cells(w, 1) = "Inne. Dla sp = " & CStr(szukanesp) & " daty są różne: " & CStr(ark1.Name) & " jest " & CStr(datadlasp) & "; " & CStr(ark2.Name) & " jest " & CStr(TabData(i))
End If

jak zamienisz to na np:
else
ark1.cells (w,kd)=Tabdata(i)
ark1.cells(w,kd).Interior.ColorIndex = 4
end if
to będzie tak jak chcesz

w ogóle to cała ta pętle if - end if można zamienić na
If not Cells(w, kD) = TabData(i) Then
ark1.cells (w,kd)=Tabdata(i)
ark1.cells(w,kd).Interior.ColorIndex = 4
end if

bezdura · Answer

Super. jeszcze raz dzieki wielkie Nawet samemu udało mi sie to poprawić tylko nie umiałem wstawić tego formatowania kolorem

bezdura · Answer

Mam jeszcze jedną sprawe. Próbowałem zrobic tak aby mozna było porównywać dane w dwóch arkuszach ale od róznych rekordów.tzn w arkuszu2 zaczyna sie od 1 a w arkuszu1 od np24.

Zmontowałem taki kod ale coś nie działa.Możesz mi podpowiedzieć co jest źle

Sub Przycisk1_Kliknięcie()


Dim jest As Boolean
Dim TabData() As Date
Dim TabSp() As String
Dim w_pierwszy As Integer
Dim w2_pierwszy As Integer
Dim k As Integer
Dim kD As Integer
Dim kSp As Integer

Set ark1 = Sheets("arkusz1")
Set ark2 = Sheets("arkusz2")
Set ark3 = Sheets("arkusz3")



'******************************
'w_pierwszy = InputBox("Wpisz nr wiersza od którego ma porownywac_ark2", "!") ' pierwszy wiersz na ark zawierający dane
kSp = 2 'oznacza kolumnę gdzie są wpisane sp. zmień na inna jeżeli potrzeba
kD = 1 ' 'oznacza kolumnę gdzie jest wpisana data. zmień na inna jeżeli potrzeba
'******************************
'z arkusza 2 pobieramy dane do tablic


'******************************
' pętla przez wszystkie dane sp na arkuszu2
' wszystkie te dane wpisujemy do tablic daty i sp
ark2.Select
w_pierwszy = InputBox("Wpisz nr wiersza od którego ma porownywac_ark2", "!") ' pierwszy wiersz na ark zawierający dane
w = w_pierwszy
Do While Cells(w, kSp) <> "" '
  If Not IsDate(Cells(w, kD)) Then GoTo nastepny
  ReDim Preserve TabData(w)
  ReDim Preserve TabSp(w)
    TabData(w) = Cells(w, kD)
    TabSp(w) = Cells(w, kSp)
nastepny:
w = w + 1
Loop
'*******************************


'********************************
' przechodzimy na ark1,  pobieramy kolejne sp i sprawdzamy z danymi w tablicach


ark1.Select
w2_pierwszy = InputBox("Wpisz nr wiersza od którego ma porownywac_ark1", "!")
w2 = w2_pierwszy
Do While Cells(w2, 2) <> ""
 szukanesp = Cells(w2, kSp)
 datadlasp = Cells(w2, kD)
    '*******************************
    ' szukamy sp z arkusza1 z danymi w tablicy sprawdzając całą tablice sp
    For i = 1 To UBound(TabSp)
       If Format(Cells(w2, kSp), "<") = Format(TabSp(i), "<") Then
            jest = True
             '**********************************
             'jeżeli znaleziono szukane sp to sprawdzamy daty na obu arkuszach
             If Cells(w2, kD) = TabData(i) Then
                 ark1.Cells(w2, 1) = CStr(datadlasp)
                 Else
                 ark1.Cells(w2, kD) = TabData(i)
                 ark1.Cells(w2, kD).Interior.ColorIndex = 4
            
             End If
             '***********************************
        End If
        If jest Then Exit For
    Next i
    '********************************
jest = False ' zerujemy zmienną. zmienna jest tylko po to, by po znalezieniu sp nie przeszukiwać dalej tablicy
w2 = w2 + 1
Loop

End Sub

wojtekcz · Answer

co konkretnie nie działa? U mnie ten kod nie pokazuje błędów.

bezdura · Answer

kurcze sorki. działa jak nalezy:) to poprostu wykonałem makro kilka razy nie zmianiajac dat i nic sie nie działo, bo przecież wszystkie daty zostały już wczesniej poprawione. dzięki jeszcze raz

wojtekcz · Answer

tak w zasadzie to powinno się ten kod trochę zmodyfikować, bo w założeniu sprawdzanie miał sie odbywać od 1-go wiersza arkusza2. W obecnej formie pozycje w tablicach od wiersza 1 do tego który sprawdzany jest jako pierwszy są puste. to tak jakbyś chciał trochę polepszyć

VBA: Porównywanie i kopiowanie rekordów między arkuszami Excel

Post #1

Post #2

Post #3

Post #4

Post #5

Post #6

Post #7

Post #8

Post #9

Post #10

Post #11

Post #12

Post #13

Post #14

Post #15

Post #16

Post #17

Post #18

Post #19

Post #20

Podsumowanie tematu