Note: The other languages of the website are Google-translated. Back to English

Jak przenieść cały wiersz do innego arkusza na podstawie wartości komórki w programie Excel?

Ten artykuł pomoże Ci przenieść cały wiersz do innego arkusza na podstawie wartości komórki.

Przenieś cały wiersz do innego arkusza na podstawie wartości komórki z kodem VBA
Przenieś cały wiersz do innego arkusza na podstawie wartości komórki za pomocą Kutools for Excel


Przenieś cały wiersz do innego arkusza na podstawie wartości komórki z kodem VBA

Jak pokazano na poniższym zrzucie ekranu, musisz przenieść cały wiersz z Arkusza1 do Arkusza2, jeśli w kolumnie C występuje określone słowo „Gotowe”. Możesz wypróbować następujący kod VBA.

1. naciśnij inny+ F11 klawisze jednocześnie, aby otworzyć Microsoft Visual Basic for Applications okno.

2. W oknie Microsoft Visual Basic for Applications kliknij wstawka > Moduł. Następnie skopiuj i wklej poniższy kod VBA do okna.

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Uwagi: W kodzie Sheet1 czy arkusz zawiera wiersz, który chcesz przenieść. I Sheet2 to docelowy arkusz roboczy, w którym zostanie umieszczony wiersz. „C: C”To kolumna zawierająca określoną wartość, a słowo„Gotowe ”To pewna wartość, na podstawie której będziesz przenosić wiersz. Zmień je w zależności od potrzeb.

3. wciśnij F5 klucz, aby uruchomić kod, wiersz spełniający kryteria Sheet1 zostanie natychmiast przeniesiony do Sheet2.

Uwagi: Powyższy kod VBA usunie wiersze z oryginalnych danych po przejściu do określonego arkusza roboczego. Jeśli chcesz tylko kopiować wiersze na podstawie wartości komórki, zamiast je usuwać. Zastosuj poniższy kod VBA 2.

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Przenieś cały wiersz do innego arkusza na podstawie wartości komórki za pomocą Kutools for Excel

Jeśli jesteś nowicjuszem w kodzie VBA. Tutaj przedstawiam Wybierz określone komórki użyteczność Kutools dla programu Excel. Za pomocą tego narzędzia możesz łatwo wybrać wszystkie wiersze na podstawie określonej wartości komórki lub różnych wartości komórek w arkuszu, a następnie skopiować wybrane wiersze do arkusza docelowego, jeśli potrzebujesz. Wykonaj następujące czynności.

Przed złożeniem wniosku Kutools dla programu ExcelProszę pobierz i zainstaluj najpierw.

1. Wybierz listę kolumn zawierającą wartość komórki, na podstawie której będziesz przenosić wiersze, a następnie kliknij Kutools > Wybierz > Wybierz określone komórki. Zobacz zrzut ekranu:

2. W otwarciu Wybierz określone komórki okno dialogowe, wybierz Cały rząd Typ wyboru sekcja, wybierz Równa się Określony typ rozwijanej liście, wprowadź wartość komórki w polu tekstowym, a następnie kliknij OK przycisk.

Inne Wybierz określone komórki pojawi się okno dialogowe, aby pokazać liczbę wybranych wierszy, a tymczasem wszystkie wiersze zawierające określoną wartość w wybranej kolumnie zostały wybrane. Zobacz zrzut ekranu:

3. wciśnij Ctrl + C klucze, aby skopiować wybrane wiersze, a następnie wklej je do potrzebnego arkusza docelowego.

Uwagi: Jeśli chcesz przenieść wiersze do innego arkusza na podstawie dwóch różnych wartości komórek. Na przykład, aby przenieść wiersze na podstawie wartości komórek „Gotowe” lub „Przetwarzanie”, możesz włączyć opcję Or stan w Wybierz określone komórki okno dialogowe, jak pokazano na poniższym zrzucie ekranu:

  Jeśli chcesz skorzystać z bezpłatnego okresu próbnego (30-dzień) tego narzędzia, kliknij, aby go pobrać, a następnie przejdź do wykonania operacji zgodnie z powyższymi krokami.


Powiązane artykuły:


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
Sortuj komentarze według
Komentarze (299)
Brak ocen. Oceń jako pierwszy!
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, uważam, że ten konkretny przewodnik jest bardzo pomocny w porównaniu z innymi, które widziałem. Dziękuję Ci! Problem, jaki mam, polega na tym, że jeśli zmienię żądaną wartość na „Zamknięty”, muszę nacisnąć klawisz F5, aby przenieść wiersz. Chciałbym, żeby poruszał się automatycznie. Jestem nowym użytkownikiem programu Excel, więc bardzo doceniam twoją pomoc. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Śledzenie incydentów ECR").UsedRange.Rows.Count J = Worksheets("Rozwiązane problemy").UsedRange.Rows. Policz Jeśli J = 1 Wtedy Jeśli Application.WorksheetFunction.CountA(Worksheets("Rozwiązane problemy").UsedRange) = 0 Wtedy J = 0 Zakończ, jeśli ustawione xRg = Worksheets("Śledzenie incydentów ECR").Range("B1:B" & I) W przypadku błędu Wznów następne Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = "Closed" Then xCell.EntireRow.Copy Destination:=Worksheets("Rozwiązane problemy").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, próbuję zautomatyzować przenoszenie ogniw bez konieczności otwierania modułu i naciskania F5. Czy kiedykolwiek rozwiązałeś to pytanie? Z góry dziękuję!
Ten komentarz został zminimalizowany przez moderatora na stronie
Crystal dostarczyła dziś informacje, jak to zrobić - zajrzyj na pierwszą stronę tego wątku, aby zobaczyć jej odpowiedź. Automatycznie przenosi wiersz z dzisiejszą datą w kolumnie (w moim przypadku L) do innego arkusza roboczego.
Ten komentarz został zminimalizowany przez moderatora na stronie
Uruchamiam ten kod i próbuję przenieść wiersz w oparciu o dzisiejszą datę widniejącą w kolumnie I - zmieniłem Range("B1:B" & I) na odczyt Range(I1:I"&I). Zmieniłem " Gotowe” w twoim przykładzie na Data. Jeśli jednak dzisiejsza data pojawi się w dowolnym miejscu wiersza, a nie tylko w kolumnie I, zgodnie z wymaganiami, wiersz zostanie przeniesiony do alternatywnego arkusza roboczego. Każdy pomysł, dlaczego tak się dzieje i jak mogę przenieść wiersz tylko wtedy, gdy dzisiejsza data jest w kolumnie I, niezależnie od tego, czy dzisiejsza data występuje w innych kolumnach?
Ten komentarz został zminimalizowany przez moderatora na stronie
Gdybym chciał mieć wiele wartości i wiele arkuszy, do których można przenieść wiersz, musiałbym ponownie napisać cały kod z inną wartością dla tej komórki? To znaczy, jeśli umieszczę NA w jednej komórce, trafi do arkusza Na, a jeśli umieszczę W #, trafi do niewłaściwego arkusza liczbowego itp.
Ten komentarz został zminimalizowany przez moderatora na stronie
cześć, to było bardzo pomocne. Czy można to zrobić bez przenoszenia wiersza danych do drugiego arkusza, ale zamiast kopiowania go? Czyli dane pozostaną na obu arkuszach?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć kod był bardzo pomocny, ale zamiast kopiowania całego wiersza wymagam przeniesienia określonego zaznaczenia wiersza do następnego arkusza. jak zdefiniować zakres zamiast całego wiersza Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Sheet2".UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Arkusz1").Range( „C1:C” & I) W przypadku błędu Wznów następne Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = „Done” Then xCell.Cały rząd.Copy Destination:=Worksheets("Arkusz2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
jaki byłby kod, gdybym chciał skopiować wiersze (określone komórki) do innego arkusza do określonych komórek? ALE również na podstawie wartości Przykład: kolorowe obrazy produktów ciąg biały blender 2 whiteblender2 czarna sokowirówka 3 blackjuicer3 czerwony telewizor 1 redtv1 zielone żelazko 4 greeniron4 Chciałbym, aby ciąg został skopiowany do innego arkusza, ale liczba w kolumnie obrazów mówi, ile razy należy go skopiować (więc w tym przypadku ciąg blendera należy skopiować w 2 rzędach
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Bardzo fajny kawałek kodu, działa bardzo dobrze. Jak zmienić ten kod, aby przenieść wiersze z jednej tabeli do drugiej, zamiast jednego arkusza do innego arkusza? Wielkie dzięki !
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Próbuję użyć kodu, ale otrzymuję błąd składni w Dim xCell As Range. Czy możesz pomóc proszę?
Ten komentarz został zminimalizowany przez moderatora na stronie
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Arkusz1").UsedRange.Rows.Count J = Worksheets("Arkusz2").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) W przypadku błędu Wznów Next Application.ScreenUpdating = False For Each xCell In xRg If CStr(xCell.Value) = "Gotowe" Then xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub jak dodać drugi arkusz roboczy, aby wiersze zostały przeniesione do arkusza 2?
Ten komentarz został zminimalizowany przez moderatora na stronie
Co powinienem wprowadzić, jeśli chcę dołączyć dowolną datę jako swoją wartość? Czyli wiersz pozostaje na arkuszu 1, jeśli nie ma daty, i przechodzi do arkusza 2, jeśli ma?
Ten komentarz został zminimalizowany przez moderatora na stronie
[cytat] cześć, to było bardzo pomocne. Czy można to zrobić bez przenoszenia wiersza danych do drugiego arkusza, ale zamiast kopiowania go? Czyli dane pozostaną na obu arkuszach?przez Maddie[/cytat] czy ktoś to rozwiązał?
Ten komentarz został zminimalizowany przez moderatora na stronie
Usuń ten "xCell.EntireRow.Delete" z kodu
Ten komentarz został zminimalizowany przez moderatora na stronie
Kiedy usuwam ten wiersz kodu i ponownie uruchamiam makro, program Excel zawiesza się. Dlaczego i jak to naprawić? Chcę, aby dane znajdowały się w obu arkuszach roboczych i nie były usuwane z oryginału. TIA
Ten komentarz został zminimalizowany przez moderatora na stronie
czy jest na to odpowiedź? Mój też się zawiesza Chciałbym skopiować, ale nie usunąć wiersza
Ten komentarz został zminimalizowany przez moderatora na stronie
Dobry dzień,
Poniższy kod VBA może pomóc tylko skopiować wiersze zamiast je usuwać.

Sub Cheezy()
Dim xRg jako zakres
Przyciemnij xCell jako zakres
Dim I tak długo
Dim J jak długo
Dim K jak długo
I = Arkusze("Arkusz1").UsedRange.Rows.Count
J = Arkusze("Arkusz2").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
Jeśli Application.WorksheetFunction.CountA(Worksheets("Arkusz2").UsedRange) = 0 Wtedy J = 0
End If
Ustaw xRg = Worksheets("Arkusz1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Fałsz
Dla K = 1 To xRg.Count
Jeśli CStr(xRg(K).Value) = "Gotowe" Wtedy
xRg(K).EntireRow.Copy Destination:=Worksheets("Arkusz2").Range("A" & J + 1)
J = J + 1
End If
Dalej
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, szukam wariacji na ten temat. Potrzebuję, aby skrypt działał w sposób ciągły lub nie działał za każdym razem, gdy zmienia się wartość w tym konkretnym polu. Sam kod działa, ale musi być uruchamiany niezależnie. Chciałbym, żeby to było zautomatyzowane. Czy ktoś może pomóc?

Nawiasem mówiąc, jeśli chcę skopiować tylko określone komórki w zakresie, jak to się dzieje?
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Rob,

Jeśli potrzebujesz skryptu do automatycznego uruchamiania po zmianie komórek w tym polu, poniższy kod VBA może ci pomóc. Kliknij prawym przyciskiem myszy zakładkę bieżącego arkusza (arkusz z wierszami, który będziesz przesuwał automatycznie), a następnie wybierz opcję Wyświetl kod z menu kontekstowego. Następnie skopiuj i wklej poniższy skrypt VBA do okna kodu.

Prywatny Sub Worksheet_Change (ByVal Target As Range)

Przyciemnij xCell jako zakres

Dim I tak długo
On Error Resume Next

Application.ScreenUpdating = Fałsz

Ustaw xCell = Cel(1)
Jeśli xCell.Value = „Gotowe” Wtedy
I = Arkusze("Arkusz2").UsedRange.Rows.Count
Jeśli I = 1 Wtedy

Jeśli Application.WorksheetFunction.CountA(Worksheets("Arkusz2").UsedRange) = 0 Wtedy I = 0

End If

xCell.EntireRow.Copy Worksheets("Arkusz2").Range("A" & I + 1)

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub


W przypadku drugiego pytania, czy masz na myśli po prostu skopiowanie kilku komórek zamiast całego wiersza? A może mógłbyś dołączyć zrzut ekranu swojego pytania? Dziękuję Ci!

Z pozdrowieniami, Kryształ
Ten komentarz został zminimalizowany przez moderatora na stronie
Kryształ,


Twoja pomoc jest bardziej niż potrzebna :)



Jak możemy dodać tutaj kolejne kryteria, na przykład chciałbym przenieść Ukończone obok Gotowe:


Prywatny Sub Worksheet_Change (ByVal Target As Range)

Przyciemnij xCell jako zakres

Dim I tak długo
On Error Resume Next

Application.ScreenUpdating = Fałsz

Ustaw xCell = Cel(1)
Jeśli xCell.Value = „Gotowe” Wtedy
I = Arkusze("Arkusz2").UsedRange.Rows.Count
Jeśli I = 1 Wtedy

Jeśli Application.WorksheetFunction.CountA(Worksheets("Arkusz2").UsedRange) = 0 Wtedy I = 0

End If

xCell.EntireRow.Copy Worksheets("Arkusz2").Range("A" & I + 1)

xCell.EntireRow.Delete
End If

Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształ
To najbardziej przydatne informacje, jakie znalazłem w sieci, a to makro robi to, czego chcę. Ale przenoszę wiersze z jednej tabeli do drugiej - a przy tym makrze informacja przenosi się do pierwszego wolnego wiersza poza tabelę, a nie do następnego wolnego wiersza w tabeli? Możesz pomóc?
Ten komentarz został zminimalizowany przez moderatora na stronie
Uruchamiam ten kod i próbuję przenieść wiersz w oparciu o dzisiejszą datę widniejącą w kolumnie I - zmieniłem Range("B1:B" & I) na odczyt Range(I1:I"&I). Zmieniłem " Gotowe” w twoim przykładzie na Data. Jeśli jednak dzisiejsza data pojawi się w dowolnym miejscu wiersza, a nie tylko w kolumnie I, zgodnie z wymaganiami, wiersz zostanie przeniesiony do alternatywnego arkusza roboczego. Każdy pomysł, dlaczego tak się dzieje i jak mogę przenieść wiersz tylko wtedy, gdy dzisiejsza data jest w kolumnie I, niezależnie od tego, czy dzisiejsza data występuje w innych kolumnach?
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Dawidzie,

Kod działa u mnie dobrze po zmianie zakresu i wartości zmiennej do tej pory. Format daty w kodzie musi być zgodny z formatem daty użytym w arkuszu. A może wygodnie jest dołączyć arkusz roboczy?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,


Nie rozumiem, co masz na myśli, mówiąc, że formaty dat w kodzie i arkuszu kalkulacyjnym muszą się zgadzać – nie jestem ekspertem VB, raczej nowicjuszem. W moim arkuszu kalkulacyjnym wpisuję dzisiejszą datę w kolumnie F jako datę wejścia wiersza, w formacie ctrl + :. Wprowadzam datę ważności w kolumnie „I” w formacie mm/dd/rrrr. Powoduje to jednak problemy podczas wprowadzania nowego wiersza i wpisywania dzisiejszej daty w kolumnie F, ponieważ zaraz po wprowadzeniu wiersz jest przenoszony do nowego arkusza roboczego.Dodatkowo nie pojawia się dodatkowy kod uruchamiany przy każdym otwarciu skoroszytu biegać beze mnie zmuszając go do tego. Przepraszam za to, co może być dla ciebie bardzo trywialne, ale po prostu nie mogę usłyszeć o tych problemach. Każda pomoc byłaby mile widziana.
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Dawidzie,

Próbowałem dokładnie tego, o czym wspomniałeś powyżej, ale problem nie występuje w moim przypadku. Czy możesz podać swoją wersję Excela? Potrzebuję więcej informacji, aby pomóc rozwiązać ten problem. Przepraszam, że znowu cię kłopotam.

Z pozdrowieniami, Kryształ
Ten komentarz został zminimalizowany przez moderatora na stronie
Crystal, to są arkusze, których dotyczy problem. W skopiowanym kodzie zobaczysz, że wyszukuję „do” dzisiejszej daty w kolumnie L, a jeśli „do” wraz z dzisiejszą datą znajduje się w tej kolumnie, chcę przenieść wiersz zawierający tę datę do nowego arkusza roboczego. Obecnie, kiedy wpisuję dzisiejszą datę w dowolnym miejscu w wierszu (na przykład w kolumnie F, jeśli wezwanie zostało wysłane dzisiaj), automatycznie przenosi cały wiersz do zarchiwizowanego arkusza kalkulacyjnego. Zwykle wpisuję dzisiejszą datę za pomocą kombinacji ctrl + : zwykle w kolumnie F.
Dodatkowo chciałbym, aby ten ruch nastąpił, gdy otworzę skoroszyt. Obecnie muszę przejść do wyświetlenia kodu, a następnie nacisnąć F5. Wszelkie porady, jak to zrobić, byłyby mile widziane.
Ten komentarz został zminimalizowany przez moderatora na stronie
Niestety mój skoroszyt z obsługą makr nie zostanie przesłany, ponieważ mówi, że format nie jest obsługiwany. Są w Excelu 2016
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Dawidzie,

Poniższy kod VBA może ci w tym pomóc.

Private Sub Workbook_Open ()
Dim xRg jako zakres
Przyciemnij xCell jako zakres
Dim I tak długo
Dim J jak długo
I = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").UsedRange.Rows.Count
J = Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
If Application.WorksheetFunction.CountA(Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange) = 0 Wtedy J = 0
End If
Set xRg = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").Range("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = Fałsz
Dla każdego xCell w xRg
Jeśli CStr(xCell.Value) = Data Wtedy
xCell.EntireRow.Copy Destination:=Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
End If
Dalej
End Sub

Uwagi:
1. Musisz umieścić skrypt VBA w oknie kodu ThisWorkbook;
2. Twój skoroszyt musi zostać zapisany jako skoroszyt programu Excel z obsługą makr.

Po wykonaniu powyższej operacji, za każdym razem, gdy otworzysz skoroszyt, cały wiersz zostanie przeniesiony do arkusza ARCHIWALNEGO, jeśli komórka w kolumnie L osiągnie dzisiejszą datę.

Z poważaniem, Kryształ
Ten komentarz został zminimalizowany przez moderatora na stronie
Dzięki Kryształowi,
Działa to świetnie, jeśli dzisiejsza data jest osiągnięta w kolumnie L. Czy jest jakiś sposób, aby uwzględnić również dzisiejszą datę w kolumnie L, aby jeśli nie sprawdzam skoroszytu przez kilka dni, automatycznie uwzględnia on wcześniejsze daty przed dzisiejszego? Bardzo ci dziękuje za pomoc.
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Dawidzie,

Przepraszam, nie jestem pewien, czy dostałem twoje pytanie. Jeśli tak, wszystkie wiersze zostaną przesunięte, o ile w kolumnie L pojawią się wcześniejsze daty?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

Jeśli nie otworzę arkusza przez kilka dni, a data wpisana w kolumnie L już minęła, tj. data w komórce w kolumnie L to 11 września 2017 r., ale nie otworzę arkusza do 13 września, chciałbym tak jak wszystkie wpisy w kolumnie L mają być sprawdzone dla każdej daty aż do dzisiejszej daty, a następnie przenieś odpowiednie wiersze do nowego arkusza. Obecnie z kodem, który łaskawie podałeś, tylko wiersze z bieżącą datą w kolumnie L są przenoszone do nowego arkusza, pozostawiając te z wcześniejszą datą w kolumnie L, które obecnie przenoszę ręcznie do nowego arkusza. Dzięki za pomoc.
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Dawidzie,



Wiem o co ci chodzi. Wypróbuj poniższy skrypt VBA. Po otwarciu skoroszytu wszystkie wiersze z datami do dzisiejszej daty w kolumnie L zostaną przeniesione do nowego określonego arkusza.



Private Sub Workbook_Open ()
Dim xRg jako zakres
Dim xRgRtn jako zakres
Przyciemnij xCell jako zakres
Dim xLastRow tak długo
Dim I tak długo
Dim J jak długo
On Error Resume Next
xLastRow = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").UsedRange.Rows.Count
Jeśli xLastRow < 1 Wyjdź z Sub
J = Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
If Application.WorksheetFunction.CountA(Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange) = 0 Wtedy J = 0
End If
Ustaw xRg = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").Range("L1:L" & xLastRow)
Dla I = 2 To xLastRow
Jeśli xRg(I).Value > Data, to wyjdź z Sub
Jeśli xRg(I).Wartość <= Data Wtedy
xRg(I).EntireRow.Copy Destination:=Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").Range("A" & J + 1)
xRg(I).Cały wiersz.Usuń
J = J + 1
ja = ja - 1
End If
Dalej
End Sub

Musisz umieścić skrypt VBA w oknie kodu ThisWorkbook i zapisać skoroszyt jako skoroszyt programu Excel z obsługą makr.
Ten komentarz został zminimalizowany przez moderatora na stronie
Dziękuję Crystal, to działa dobrze.
Ten komentarz został zminimalizowany przez moderatora na stronie
Crystal, trochę pośpiesznie odpowiedziałem, że kod działa. Otworzyłem dzisiaj mój skoroszyt, a wiersze zawierające wcześniejsze wpisy dat w komórce kolumny L nadal znajdują się w „arkuszu bieżących możliwości oazy” i nie zostały przeniesione do „arkusza zarchiwizowanego oazy”, zgodnie z oczekiwaniami. Jakieś pomysły, dlaczego tak by się stało?
Ten komentarz został zminimalizowany przez moderatora na stronie
Podświetlone komórki znajdują się w kolumnie L w odniesieniu do powyższego pytania i są kryteriami (do dzisiejszej daty) przeniesienia wiersza do nowego arkusza roboczego. Mam nadzieję, że ten obraz pomoże.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jest to również kopia okna VBA związanego z powyższym.
Ten komentarz został zminimalizowany przez moderatora na stronie
Crystal, trochę pośpiesznie odpowiedziałem, że kod działa. Otworzyłem dzisiaj mój skoroszyt, a wiersze zawierające wcześniejsze wpisy dat w komórce kolumny L nadal znajdują się w „arkuszu bieżących możliwości oazy” i nie zostały przeniesione do „arkusza zarchiwizowanego oazy”, zgodnie z oczekiwaniami. Jakieś pomysły, dlaczego tak by się stało?
Ten komentarz został zminimalizowany przez moderatora na stronie
Kryształ,

Ponieważ nie mogę przesłać mojego skoroszytu, odtworzę tutaj wiersze i kolumny

ABCDEFGHIJKL
# Rodzaj Pozyskiwanie odłogowania Zmień # Data wydania Pytania Miejsce dostawy do klienta Propozycja projektu Termin

1 SS SB 1234567 1 09/6/17 Brak nazwy armii Miejsce Napęd Tank 09/10/17

Używając poniższego kodu, chcę, aby przeniósł cały wiersz do nowego arkusza roboczego, gdy kolumna L osiągnie dzisiejszą datę. Również jeśli nie wypełniłem arkusza przez kilka dni, chciałbym użyć wyszukiwania „do dzisiejszej daty” w kolumnie L, aby zrobić to samo. Chciałbym również, aby robiło to automatycznie po otwarciu skoroszytu, jeśli to możliwe. Obecnie, jeśli wprowadzę dzisiejszą datę w dowolnej komórce w wierszu, na przykład w kolumnie F podczas wprowadzania danych, cały wiersz zostanie przeniesiony do arkusza archiwum. (Korzystając z Excela 2016)

[Kod modułu 1)

Sub DaveV()

Dim xRg jako zakres

Przyciemnij xCell jako zakres

Dim I tak długo

Dim J jak długo

I = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").UsedRange.Rows.Count

J = Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange.Rows.Count

Jeśli J = 1 Wtedy
If Application.WorksheetFunction.CountA(Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange) = 0 Wtedy J = 0

End If

Set xRg = Worksheets("BIEŻĄCE MOŻLIWOŚCI W OAZIE").Range("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = Fałsz

Dla każdego xCell w xRg

Jeśli CStr(xCell.Value) = Data Wtedy

xCell.EntireRow.Copy Destination:=Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").Range("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
End If

Dalej
Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
[Kod arkusza 1]

Prywatny Sub Worksheet_Change (ByVal Target As Range)
Przyciemnij xCell jako zakres
Dim I tak długo
On Error Resume Next
Application.ScreenUpdating = Fałsz
Ustaw xCell = Cel(1)
Jeśli xCell.Value = Data, wtedy
I = Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange.Rows.Count
Jeśli I = 1 Wtedy
If Application.WorksheetFunction.CountA(Worksheets("MOŻLIWOŚCI ZARCHIWIZOWANEJ OAZY").UsedRange) = 0 Then I = 0 End If
xCell.EntireRow.Copy Worksheets("MOŻLIWOŚCI ARCHIWIZACJI W OAZIE").Range("A" & I + 1)
xCell.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub

Mam nadzieję, że powyższe pomoże, ale nie jestem osobą VBA, dlatego nie rozumiem, jak sprawić, by kod robił to, czego potrzebuję. Twoja pomoc byłaby mile widziana.
Ten komentarz został zminimalizowany przez moderatora na stronie
W twoim skrypcie jest duży błąd!

Załóżmy, że wykryłeś, że wiersz 7 zawiera słowo „Gotowe” w kolumnie C, więc skopiuj go i usuń wiersz.
Po usunięciu wiersza następny wiersz na liście będzie wierszem 9, a nie 8, ponieważ po usunięciu 7 linii, teraz zawartość 8 linii jest w linii 7, a wszystkie linie przeszły w górę o 1 wiersz. Następny wiersz do sprawdzenia miał być wierszem 8, ale teraz zawiera dane, które poprzednio znajdowały się w wierszu 9, więc za każdym razem, gdy usuwasz wiersz, w rzeczywistości pomijasz wiersz do sprawdzenia!
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Shau Alonie,

Dziękuję za Twój komentarz. Kod został zaktualizowany z naprawionym błędem. Dziękuję bardzo za twojego asystenta.

Z pozdrowieniami, Kryształ
Ten komentarz został zminimalizowany przez moderatora na stronie
Myślę, że to się ze mną dzieje, kopiuje w kółko ten sam wiersz, mimo że mówi, że kod został zaktualizowany. Oto co mam:

Sub Cheezy()
„Zaktualizowany przez Kutools dla programu Excel 2017/8/28”
Dim xRg jako zakres
Przyciemnij xCell jako zakres
Dim I tak długo
Dim J jak długo
Dim K jak długo
I = Worksheets("PLAN ZAKUPU").UsedRange.Rows.Count
J = Worksheets("Archiwum zakupów").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
If Application.WorksheetFunction.CountA(Worksheets("Archiwum zakupów").UsedRange) = 0 Wtedy J = 0
End If
Ustaw xRg = Worksheets("PLAN ZAKUPU").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = Fałsz
Dla K = 1 To xRg.Count
Jeśli CStr(xRg(K).Value) = "Tak" Wtedy
xRg(K).EntireRow.Copy Destination:=Worksheets("Archiwum zakupów").Range("A" & J + 1)
xRg(K).Cały wiersz.Usuń
Jeśli CStr(xRg(K).Value) = "Tak" Wtedy
K = K - 1
End If
J = J + 1
End If
Dalej
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi Fred,
Za każdym razem, gdy uruchamiasz kod, kod wyszukuje określony zakres, więc kopiuje ten sam wiersz w kółko, ponieważ nie może stwierdzić, który wiersz został już skopiowany. Aby uniknąć wielokrotnego kopiowania tego samego wiersza, możesz uruchomić kod automatycznie po wprowadzeniu pasującej wartości w określonej komórce.
W arkuszu o nazwie „PLAN ZAKUPU” kliknij prawym przyciskiem myszy kartę arkusza i kliknij Wyświetl kod z menu kontekstowego. Następnie skopiuj następujący kod VBA w oknie Arkusz (Kod).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy ktoś mógłby mi pomóc sprawić, by to zadziałało? Próbowałem zmienić część, która musi pasować do mojego pliku, ale to się pojawia i nie jestem pewien, co robić.
Ten komentarz został zminimalizowany przez moderatora na stronie
mówi, że plik nie jest obsługiwany, gdy próbuję przesłać plik programu Excel. Przepraszam... zmagam się z tym dzisiaj.
Ten komentarz został zminimalizowany przez moderatora na stronie
Potrzebuję pomocy przy podobnym zadaniu, ale nieco innym. Mam 5 kolumn liczb, około 25000 na kolumnę, każda kolumna z nagłówkiem 1-5. Chciałbym skopiować cały wiersz do innego arkusza, jeśli wartość kolumny 1 jest większa od zera, LUB kolumna 2 jest większa od zera , OR kolumna 3 jest mniejsza od zera, LUB kolumna 4 jest większa niż pięć LUB kolumna 5 jest większa niż dwa itd. czy to możliwe?
Ten komentarz został zminimalizowany przez moderatora na stronie
przesyłanie obrazu nie działa... przepraszam.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,
Użyj przycisku przesyłania tego.
Ten komentarz został zminimalizowany przez moderatora na stronie
Więc celem jest sprawdzenie, czy któryś z gazów przekracza limit, który ustawię we wzorze, cała ikra jest SKOPIOWANA na nowy arkusz.

Dziękuję bardzo za pomoc.
Ten komentarz został zminimalizowany przez moderatora na stronie
Załączony obraz
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Michale,
Może uda Ci się rozwiązać ten problem za pomocą dodatku do programu Excel. Tutaj polecam narzędzie Wybierz określone komórki narzędzie Kutools dla programu Excel. Za pomocą tego narzędzia możesz łatwo wybrać wszystkie wiersze w zakresie certian, jeśli wartość określonej kolumny jest większa lub mniejsza niż liczba. Po wybraniu wszystkich potrzebnych wierszy możesz ręcznie skopiować i wkleić je do nowego arkusza roboczego. Zobacz poniżej załączony obraz.

Możesz dowiedzieć się więcej o tej funkcji, korzystając z poniższego hiperłącza.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Ten komentarz został zminimalizowany przez moderatora na stronie
dzięki za tę formułę, ale miałem problem polegający na tym, że gdy chcę przenieść wiersz do innego arkusza, nie dzieje się to automatycznie. czy możesz podać mi inną formułę? więc za każdym razem, gdy zmieniam wartość komórki, porusza się ona automatycznie.


dzięki
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Janang,
Dawka kodu nie nastąpi automatycznie, dopóki ręcznie nie naciśniesz przycisku uruchamiania.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Chciałbym ustawić to makro, ale z 2 argumentami. Udało mi się uruchomić makro w moim pliku na podstawie wartości komórek w kolumnie O. Jednak chciałbym, aby makro sprawdziło również, czy kolumna S jest wypełniona (lub <> ""), przed przeniesieniem wiersza . Na koniec chciałbym, aby skopiowane wiersze miały takie samo formatowanie, jak wiersze w drugim arkuszu. Czy to całkowicie zmienia makro?
Ten komentarz został zminimalizowany przez moderatora na stronie
Drodzy Hugues,
Nie wiem, czy dobrze Cię rozumiem. Masz na myśli, że jeśli komórka w kolumnie S jest wypełniona, a komórka w kolumnie O zawiera jednocześnie określoną wartość, to przesunąć wiersz z formatowaniem? W przeciwnym razie nie ruszaj się?
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj Kryształowo,

Tak, dokładnie to mam na myśli. W rzeczywistości moje dane dotyczą projektów. Moja kolumna O to stan mojego projektu, a S data zakończenia mojego projektu.
Chcę, aby moi użytkownicy, osoby, które mają informacje i będą musiały je wstawić, mogły „Archiwizować” projekt TYLKO, jeśli mają status „Zamknięty” i wprowadzili „Datę końcową”.


Mam nadzieję, że to pomoże wyjaśnić rzeczy
Ten komentarz został zminimalizowany przez moderatora na stronie
Drodzy Hugues,
Przepraszam za odpowiedzi tak późno. Poniższy kod VBA może pomóc w rozwiązaniu problemu. Wykonaj czynności opisane w tym artykule, aby zastosować skrypt VBA.

Sub MoveRowBasedOnCellValue()
Dim xRg Status jako zakres
Dim xRgDate jako zakres
Dim I tak długo
Dim J jak długo
Dim K jak długo
I = Arkusze("Arkusz1").UsedRange.Rows.Count
J = Arkusze("Arkusz2").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
Jeśli Application.WorksheetFunction.CountA(Worksheets("Arkusz2").UsedRange) = 0 Wtedy J = 0
End If
Ustaw xRgStatus = Worksheets("Arkusz1").Range("O1:O" & I)
Ustaw xRgDate = Worksheets("Arkusz1").Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = Fałsz
Application.CutCopyMode = False
xRgStatus(1). Cały wiersz. Kopiuj
Arkusze ("Arkusz2").Range("A" i J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Dla K = 2 To xRgStatus.Count
Jeśli CStr(xRgStatus(K).Value) = "Zamknięty" Wtedy
Jeśli (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Data") Wtedy
xRgStatus(K). Cały wiersz. Kopiuj
Arkusze ("Arkusz2").Range("A" i J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
End If
End If
Dalej
Application.CutCopyMode = Prawda
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Kryształu,

Dziękuję bardzo za pomoc!

Pozdrowienia,

Hugues
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,


Jak skopiować wiersze zamiast je przenosić?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,


Wiem, że zostało to wysłane kilka razy, ale nie mogę znaleźć odpowiedzi. Jak mogę skopiować materiał do nowego arkusza i NIE usuwać go z oryginalnego arkusza?
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Mike,
Jeśli chcesz skopiować wiersze zamiast je usuwać, może ci pomóc poniższy kod VBA. Dziękuję za Twój komentarz!

Sub Cheezy()
Dim xRg jako zakres
Przyciemnij xCell jako zakres
Dim I tak długo
Dim J jak długo
Dim K jak długo
I = Arkusze("Arkusz1").UsedRange.Rows.Count
J = Arkusze("Arkusz2").UsedRange.Rows.Count
Jeśli J = 1 Wtedy
Jeśli Application.WorksheetFunction.CountA(Worksheets("Arkusz2").UsedRange) = 0 Wtedy J = 0
End If
Ustaw xRg = Worksheets("Arkusz1").Range("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Fałsz
Dla K = 1 To xRg.Count
Jeśli CStr(xRg(K).Value) = "Gotowe" Wtedy
xRg(K).EntireRow.Copy Destination:=Worksheets("Arkusz2").Range("A" & J + 1)
J = J + 1
End If
Dalej
Application.ScreenUpdating = True
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Jestem nowy w używaniu makr, czy można wkleić poniższe dane po określonej wartości i będą powtarzane do końca kolumny?
Jak to:

Przenieś „Niebieski” po „Kolor”

A1 = niebieski
A5 = kolor
A6= (przenieś tutaj „Niebieski”)
i tak dalej ...
Ten komentarz został zminimalizowany przez moderatora na stronie
Dear John,
Czy masz na myśli, że jeśli komórka zawiera „Kolor” w kolumnie, to skopiuj tekst pierwszej komórki do komórki poniżej „Kolor” i powtórz kopiowanie tego tekstu do końca kolumny?
Nie ma tu jeszcze żadnych komentarzy
Pokaż więcej

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL