--> Archiwum Forum
Yans [ Więzień Wieczności ]
Visual Basic / makra Excel
Witam, czy ktoś tutaj jest na tyle obeznany z VBA i makrami, żeby pomóc mi w zmodyfikowaniu kodu, który ma porównywać dane między dwoma arkuszami ?
Kod wygląda jak poniżej, jeśli komuś coś to mówi, to proszę dać znać i podam wtedy dokladnie co chcę uzyskać i podeślę plik.
Sub WstawArea()
Arkusz1 = "Rent Roll - O"
Arkusz2 = "ERV Schedule - T"
Dim Area2 As Range
For Each Area2 In Worksheets(Arkusz2).Range("A7").CurrentRegion.Columns(2).Cells
If IsEmpty(Area2) Then
Area2.Value = WyszukajArea(CStr(Area2.Offset(0, -1).Value) _
, Worksheets(Arkusz1), 8)
End If
Next Area2
End Sub
Private Function WyszukajArea(Unit As String, Ark As Worksheet, Kolumna As Integer) As String
Dim Wynik As String
With Ark
On Error Resume Next
Wynik = Application.WorksheetFunction.VLookup(Unit, .UsedRange, Kolumna, False)
On Error GoTo 0
WyszukajArea = Wynik
End With
End Function
albz74 [ Legend ]
Wygląda na jakąś zajebiście koronkową robotę :)
No dobra, dawaj Adam, mam chwilę :)
Dym14 [ C L I N I C ]
Szczerze, to nie rozumiem tego kodu ale jestem w stanie napisać w VBA kod który porównuje dane/arkusze i wyświetla np. takie same "dane" albo osoby o takich samych nazwiskach. Ostatnio pisałem kod który wyszukuje wpisane przez nas nazwisko w 3 arkuszach a jak nie trudno się domyślić operuje to na porównywaniu. Opisz bardziej sprawę jak możesz. Nie wiem czy zdołam Ci pomóc ale spróbować mogę. Może być tutaj lub na maila [email protected] .
Yans [ Więzień Wieczności ]
albz74 ====> Podaj proszę jakiegoś maila albo napisz na mojego: [email protected]
Dym14 ====> Mail z pilkiem poszedł.
Mały opis sytuacji. Podejrzewam, że rozwiązania nie ma albo jest niezwykle banalne :) Jeśli coś jest nie jasne, to proszę pytajcie :)
Chcę aby dla kolumny 1 w arkuszu 'Rent Roll - O' procedura szukała takiej samej wartości w kolumnie 1 arkusza 'ERV Schedule - T' i jeśli ją znajdzie, to z arkusza 1 'Rent Roll - O' ma skopiować wartość z kolumny 8 i wstawić w arkuszu 2 'ERV Schedule - T' w kolumnie 2
W chwili obecnej procedura przeszukuje kolumnę 1 w Arkuszu1 (Rent Roll - O) i dzięki temu znajduje wartości Area dla Unit'ów GNB26 oraz GNB48, które są inaczej posortowane niż w Arkuszu2 (ERV Schedule - T). Niestety wydaje mi się, że procedura wywraca się gdy w Arkuszu2 (ERV Schedule - T) dochodzi do końca sekcji BOUTIQUES czyli komórki B55 i nie radzi sobie z komórkami w kolejnych 4 wierszach, a tym samym nie działa już dla komórki B59. Oczywiście docelowo nie chodzi mi, żeby procedura wskazywała konkretne komórki ale opierała sie na porównaniu wszystkich wartości z kolumny 1 z Arkusza2 (ERV Schedule - T) z kolumną 1 w Arkuszu1 (Rent Roll - O).
W pliku na zielono zaznaczyłem wartości, które teraz się kopiują, a na czerwono te, które się nie kopiują. Tak dla pełnej jasności :)
Mephistopheles [ Hellseeker ]
Łatwizna. Jeśli dobrze zrozumiałem, to wystarczy użyć funkcji CZY.BŁĄD.
Jeśli jeszcze nie masz rozwiązania, to ślij plik na mephraiser [małpa] gmail [kropka] com.
albz74 [ Legend ]
Pliku jeszcze nie dostałem, ale zapytam dlaczego nie zrobisz tego prostą formułą, tylko używasz kodu ?
Dym14 [ C L I N I C ]
Nie pomogę Ci niestety. Napisałem kod ale nie jestem w stanie go zmusić do działania bo wyskakuje mi błąd Runtime error 424 Object required. Nigdy się nie spotkałem z takim błędem inne makra w innych plikach mi działają.
Oto kod ale raczej się nie przyda. To znaczy zalążek kodu bo jeżeli by zadziałał to dopisałbym jeszcze żeby samo wykrywało ilość wierszy bo jak się domyślam będzie różna.
Dim w As Integer
Dim i As Integer
For w = 9 To 66
aaa = Arkusz1.Cells(w, 8).Value
bbb = Arkusz1.Cells(w, 1).Value
For i = 7 To 66
s = Arkusz2.Cells(i, 1).Value
If bbb = s Then
Arkusz2.Cells(i, 2).Value = aaa
End If
Next i
Next w
Mephistopheles [ Hellseeker ]
Yans ---> Sprawdź maila, bo nie wiem, czy - w zależności od potrzeb - rozwiązałem wszystkie problemy niezwykle prostym i błyskotliwym sposobem, czy odwaliłem tanią chałturę, którą wstyd ludziom pokazać. :P
albz74 [ Legend ]
Meph - ręcznie się to robi w 0,3 sek
W zasadzie efekt można osiągnąć zwykłym vlookupem. Nie wiem, dlaczego Yans chce tam mieć makro.
No właśnie, dlaczego ??????
Mephistopheles [ Hellseeker ]
Tyle tylko, że sposób "odręczny" (o ile myślimy o tym samym) wysypie się jak landrynki z puszki, jeśli dopisze się jakąkolwiek dodatkową wartość. Ale jeśli ilość komórek w drugiej tabeli ma być stała, to rozwiązanie nie wymaga jakiejś strasznej pracy.
albz74 [ Legend ]
Meph- jak zbudujesz formułę, to nic się nie wysypie bo to Ty masz kontrolę, gdzie ją wkleisz. Wzmiankowane makro wysypuje się na metodzie CurrentRegion, które to nie lubi zmian zawartości w skrajnych komórkach, stąd zaznacza obszar , który nie zawiera wszystkich wymaganych wierszy.
Rozwiązań jest wiele; sprawdzanie, który wiersz jest pierwszy pusty, który wiersz nie ma w pierwszej kolumnie odpowiedniego numeru (numerowanie jest charakterystyczne), etc. W zależności od tego, jak rozwiązanie ma być 'eleganckie' i uniwersalne, można to makro zbudować na wiele sposobów. Ale tak naprawdę, wystarczy formuła, jeżeli arkuszy nie jest 1000.
albz74 [ Legend ]
Ok, już wiem. Jak zwykle coś, na co trudno wpaść.
For Each Area2 In Worksheets(Arkusz2).Range("A7").CurrentRegion.Columns(2).Cells
If IsEmpty(Area2) Then
Area2.Value = WyszukajArea(CStr(Area2.Offset(0, -1).Value) _
, Worksheets(Arkusz1), 8)
End If
Next Area2
Warunek, żeby zadziałało wyszukiwanie jest taki, żeby komórka była pusta. Pola zaznaczone na czerwono nie są puste, są tam wstawione spacje, których oczywiście nie widać, dopóki się nie zacznie edytować komórki. Po usunięciu spacji makro działa do końca poprawnie.
Yans [ Więzień Wieczności ]
Dzięki wszystkim za pomoc !!!
albz74 ====> Marcin masz oko :) To prawie jak "czeski błąd" z tymi spacjami, a w komórce A57 wstawiłem "NIE USUWAC TEGO BO PRZESTANIE DZIAŁAC MAKRO !!!" :) Masz może pomysł co zrobić, żeby uodpornić procedurę na taką spację jak w A57 ? Wtedy już by było prawie idealne :)
Meph ====> Coś takiego kombinowałem ale jednak potrzebuję elastycznego rozwiązania bez podawnia stałych zakresów. W każdym bądź razie patent z obszarem roboczym wykorzystam w innym rozwiązaniu.
Dym14 ====> Może, mimo wszystko, warto dociec skąd ten błąd ?
albz74 [ Legend ]
Masz może pomysł co zrobić, żeby uodpornić procedurę na taką spację jak w A57 ? Wtedy już by było prawie idealne :)
Można :
1. Ustawić walidację danych i wpisać listę możliwych wartości - podać tylko spację. Ktokolwiek by chciał ją usunąć albo wpisać co innego - Excel zabroni
2. Zablokować komórkę - w formatowaniu komórki, zakładka protection, Locked ustawić na tak. I protect sheet. Tylko trzeba odblokować te komórki, w których makro wpisuje dane. Bo domyślnie Excel we wszystkich wstawia Locked = Yes
To tak na szybko
legrooch [ MPO Squad Member ]
A może wykonać Trim na komórkach?
albz74 [ Legend ]
Można, tylko obecna pętelka przelatuje po obszarach i trim się wywali bo nie działa na obiekcie, trzeba przekierować do wartości komórki
legrooch [ MPO Squad Member ]
albz ==> Przy wartościach w Ifie Twoim można by zrobić dodatkową weryfikację, ale to inna sprawa :)
Zastanawia mnie jedno - po co tam są te spacje? :)
Pan Majonez [ Chor��y ]
https://forumarchiwum.gry-online.pl/S043archiwum.asp?ID=10272452&N=1
Yans [ Więzień Wieczności ]
albz74, legrooch ====> Bardziej chodziło mi o usprawnienie samej procedury, żeby była odporna w kolumnie A na puste komórki, a nie o blokowanie komórek przed usunięciem z nich wartości przez juzka :) Ale spoko, to najwyżej przy okazji, na razie jest OK w takiej wersji jak jest.
Pan Majonez ====> Polecam strony:
A co do książek, to na przykład to:
Rebel Mr Spanky [ Generaďż˝ ]
Ja też się podepnę pod temat- czy najnowsza wersja VB wymaga servis pack 3, bo coś mi chce chce pójść na laptopie gdzie mam xp z servis pack 2. Jak Windows nielegalny to nie ma problemów z aktualizacją do 3 ?