Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - filtrowanie danych

grzesioi · Exceloholic Posty: 166

Witam,
potrzebuję makro które wykona następujące czynności:

Na podstawie danych z kolumny "A" w arkuszu "Marba", wytnie i przeniesie cały wiersz z danymi z Arkusza "Eorg" (porównując dane z kolumny "H") do Arkusza "Przefiltrowane"

Potem,

Na podstawie nowych danych z Arkusza "Przefiltrowane" z kolumny "F" znajdzie takie same wartości w Arkuszu "Nowy_plik" (kolumna B) i usunie cały wiersz.

Z góry dziękuję. :-)

test.xlsx

Pobierz Plik ściągnięto 7 raz(y) 167.06 KB

kuma · Wysłany: 17-03-2021, 19:25

grzesioi · Exceloholic Posty: 166

W kolumnie B (nowy_plik) dodatkowo poza kodem jest po spacji jeszcze rozmiar. I tylko tym różnią się te kolumny.
Inaczej mówiąc kolumna B ( nowy plik) to kolumna F (eorg) + po spacji dodatkowo rozmiar. Po zastosowaniu pierwszego makra i przeniesieniu części wierszy z arkusza Eorg do arkusza przefiltrowane kolumny nie zmienią się.

Chodzi mi o to że potrzebuję wyłapać wszystkie wiersze w których zawarty jest kod z kolumny F (przefiltrowane) i skasować te wiersze w arkuszu nowy plik Kolumna do porównania to właśnie B w której zawarty jest ten sam kod tylko dodatkowo po spacji ma jeszcze liczbę.

kuma · Wysłany: 17-03-2021, 23:18

Sprawdź, czy moje rozwiązanie działa wg Twoich oczekiwań.

test(2)Kopiowanie_kuma.xlsm

Pobierz Plik ściągnięto 8 raz(y) 180.56 KB

grzesioi · Exceloholic Posty: 166

Jeśli odpalam makro w swoim pliku wyskakuje mi błąd. (zał)
Jeśli odpalę Twój plik testowy to nie mam błędu. Czy problemem może być duża liczba danych (około 2000 poz)

1.JPG

Plik ściągnięto 293 raz(y) 18.01 KB

row.JPG

Plik ściągnięto 4 raz(y) 44.04 KB

kuma · Wysłany: 18-03-2021, 09:11

Miał prawo pojawiać się taki błąd, gdy nie znalazł kodu do usunięcia.
Wstawiłem obsługę tego błędu i powinno być okay.
Podmień kod na ten poniżej.

Kod:

Sub Copy_kuma()
Dim a, v
Dim toDel As Range, b As Range
Dim shE As Worksheet, shP As Worksheet, shN As Worksheet
Dim i As Integer, rw As Integer

Application.ScreenUpdating = False
Set shE = ThisWorkbook.Sheets("Eorg")
Set shP = ThisWorkbook.Sheets("Przefiltrowane")
Set shN = ThisWorkbook.Sheets("Nowy_plik")

a = Sheets("Marba").[a1].CurrentRegion
shP.Cells.Delete
With shE
.Rows(1).Copy shP.[a1]
For i = 1 To UBound(a)
Set b = .Columns("h").Find(a(i, 1), lookat:=xlPart)
If Not b Is Nothing Then
.Rows(b.Row).Copy shP.Range("a" & shP.Cells(Rows.Count, "a").End(3).Row)(2)
shP.Range("h" & shP.Cells(Rows.Count, "a").End(3).Row)(1).Value = a(i, 1)
End If
Next
End With
With shP.Columns("h")
.WrapText = False
.AutoFit
End With

With shN
With shP.[f1].CurrentRegion
a = .Offset(1).Columns("f").Resize(.Rows.Count - 1).Value
End With

For i = 1 To UBound(a)
Set b = .Columns(2).Find(a(i, 1), lookat:=xlPart)
If Not b Is Nothing Then
rw = b.Row
Do
If Not b Is Nothing Then
If Split(b, " ")(0) = a(i, 1) Then
Set toDel = Union(IIf(toDel Is Nothing, b, toDel), b)
End If
End If
Set b = .Columns(2).FindNext(b)
Loop Until rw = b.Row
End If
Next
If Not toDel Is Nothing Then toDel.EntireRow.Delete
End With
End Sub

grzesioi · Exceloholic Posty: 166

Teraz mam taki błąd.

2.JPG

Plik ściągnięto 8 raz(y) 75.97 KB

kuma · Wysłany: 18-03-2021, 10:29

Sprawdź.

test(2)Kopiowanie_kuma.xlsm

Pobierz Plik ściągnięto 6 raz(y) 182.43 KB

grzesioi · Exceloholic Posty: 166

teraz przetworzyło bez błędów. ( "Brak przefiltrowanych") Ale nie znalazło danych do przeniesienia, a na pewno są. Ręcznie funkcją znajdź- znajduje dane.

kuma · Wysłany: 18-03-2021, 10:44

Daj załącznik z różnymi rodzajami danych, bo taka zgadywanka do niczego dobrego nie prowadzi, a zajmuje tylko niepotrzebnie czas mój i Twój. ;-)

grzesioi · Exceloholic Posty: 166

Proszę

Eoryg1-4 makro.xlsx

Pobierz Plik ściągnięto 5 raz(y) 675.6 KB

kuma · Wysłany: 18-03-2021, 11:48

Wg mnie działa dobrze. Jeśli, wg Ciebie, nie przenosi wszystkich to podaj, których to numerów z 'Margo' dotyczy.
Może są różne zapisy w arkuszach, a wyglądają tak samo.

grzesioi · Exceloholic Posty: 166

Nie przenosi mi nic. mam komunikat: brak przefiltrowanych. A numery z Arkusza Marba z kolumny A występują na pewno w arkuszu Eorg ( wszystkie albo prawie wszystkie)
Czy muszę coś zrobić zanim uruchomię makro "Copy_kuma" ( zaznaczyć coś? )
Wyślij mi plik jak u Ciebie to przeniosło.

kuma · Wysłany: 18-03-2021, 12:11

Nie musisz nic wybierać. Uruchamiasz tylko procedurę 'Copy_kuma'.
Jak nie wiesz jak to uruchomić to: zakładka Deweloper --> Makra i wybierasz 'Copy_kuma'

Eoryg1-4 makro_kuma.xlsm

Pobierz Plik ściągnięto 6 raz(y) 686.47 KB

grzesioi · Exceloholic Posty: 166

na Twoim mi poszło.

nie kasuje wierszy z Arkusza Eorg -tych co przenosi np 191884353686 4060978794734.
I w Arkuszu nowy_plik nie powinno go być.