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

Hogyan lehet a teljes sort áthelyezni egy másik lapra az Excel cellája alapján?

Ez a cikk segítséget nyújt a teljes sor áthelyezéséhez egy másik lapra a cellaérték alapján.

Helyezze a teljes sort egy másik munkalapra a VBA kóddal ellátott cellaérték alapján
A Kutools for Excel segítségével helyezze át a teljes sort egy másik lapra a cellaérték alapján


Helyezze a teljes sort egy másik munkalapra a VBA kóddal ellátott cellaérték alapján

Amint az alábbi képernyőképen látható, a teljes sort az 1. lapról a 2. lapra kell áthelyeznie, ha a C oszlopban szerepel egy adott „Kész” szó. Kipróbálhatja a következő VBA kódot.

1. nyomja meg más+ F11 gombok egyszerre a Microsoft Visual Basic for Applications ablak.

2. A Microsoft Visual Basic for Applications ablakban kattintson a gombra betétlap > Modulok. Ezután másolja és illessze be az alábbi VBA kódot az ablakba.

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

Megjegyzések: A kódban Sheet1 a munkalap tartalmazza az áthelyezni kívánt sort. És Sheet2 az a cél munkalap, ahova megtalálja a sort. „C: C”Az oszlop tartalmazza a bizonyos értéket, és a„csinált”Az a bizonyos érték, amely alapján a sort áthelyezi. Kérjük, változtassa meg őket az Ön igényei szerint.

3. megnyomni a F5 gombot a kód futtatásához, akkor az a sor, amely megfelel az 1. lap kritériumainak, azonnal a 2. lapra kerül.

Megjegyzések: A fenti VBA-kód törli a sorokat az eredeti adatokból, miután áttér egy meghatározott munkalapra. Ha csak a cellák értéke alapján akar sorokat másolni törlés helyett. Kérjük, alkalmazza az alábbi VBA kódot 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

A Kutools for Excel segítségével helyezze át a teljes sort egy másik lapra a cellaérték alapján

Ha újonc vagy a VBA kódban. Itt mutatom be a Válassza a Specifikus cellák lehetőséget hasznossága Kutools az Excel számára. Ezzel a segédprogrammal könnyedén kiválaszthatja az összes sort egy adott cellaérték vagy egy munkalap különböző cellaértékei alapján, és szükség szerint másolhatja a kijelölt sorokat a cél munkalapra. Kérjük, tegye a következőket.

Alkalmazás előtt Kutools az Excel számáraKérjük, először töltse le és telepítse.

1. Válassza ki azt az oszloplistát, amely tartalmazza a cellák értékét, amelyek alapján a sorokat áthelyezi, majd kattintson a gombra Kutools > választ > Válassza a Specifikus cellák lehetőséget. Lásd a képernyőképet:

2. A nyílásban Válassza a Specifikus cellák lehetőséget párbeszédpanelen válassza a lehetőséget Teljes sor a Kiválasztás típusa válasszon Egyenlő a Konkrét típus legördülő listából írja be a cella értékét a szövegmezőbe, majd kattintson a gombra OK gombot.

Másik Válassza a Specifikus cellák lehetőséget felbukkan a párbeszédpanel, amely megmutatja a kijelölt sorok számát, és közben minden sor a kiválasztott oszlopban megadott értéket tartalmazza. Lásd a képernyőképet:

3. megnyomni a Ctrl + C gombokat a kijelölt sorok másolásához, majd illessze be őket a kívánt munkalapra.

Megjegyzések: Ha két különböző cellaérték alapján szeretne sorokat áthelyezni egy másik munkalapra. Például a "Kész" vagy a "Feldolgozás" cellaértékek alapján mozgathatja a sorokat, engedélyezheti a Or állapot a Válassza a Specifikus cellák lehetőséget párbeszédpanel az alábbi képernyőképen:

  Ha szeretnél egy ingyenes próbaidőszakot (30-nap) ebből a segédprogramból, kattintson a letöltéshez, majd lépjen a művelet végrehajtására a fenti lépések szerint.


Kapcsolódó cikkek:


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja
A megjegyzések rendezése szerint
Hozzászólások (299)
Még nincs értékelés. Legyen Ön az első, aki értékel!
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló! Ezt az útmutatót nagyon hasznosnak találtam a többihez képest. Köszönöm! Az a bajom, hogy ha a kívánt értéket 'Closed'-re állítom, le kell futtatnom az F5 billentyűt a sor mozgatásához. Szeretném, ha automatikusan mozogna. Új vagyok az Excelben, ezért nagyra értékelem a segítségét. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Megoldott problémák").UsedRange.Rows. Számolás, ha J = 1, akkor ha Application.WorksheetFunction.CountA(Worksheets("Megoldott problémák").UsedRange) = 0 Akkor J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Tartomány("B1:B" & I) Hiba esetén Folytatás a következő alkalmazásban.ScreenUpdating = Hamis minden xCell in xRg esetén Ha CStr(xCell.Value) = "Closed", akkor xCell.EntireRow.Copy Destination:=Worksheets("Megoldott problémák").Tartomány("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló! Megpróbálom automatizálni a cellák áthelyezését anélkül, hogy ki kellene nyitnom a modult és meg kellene nyomnom az F5-öt is. Megoldottad valaha ezt a kérdést? Előre is köszönöm!
A weboldal moderátora ezt a megjegyzést minimalizálta
Crystal tájékoztatást adott arról, hogyan kell ezt ma megtenni – vessen egy pillantást ennek a szálnak az első oldalára, hogy megtudja válaszát. Automatikusan áthelyezi a mai dátumot tartalmazó sort egy oszlopban (esetemben L) egy másik munkalapra.
A weboldal moderátora ezt a megjegyzést minimalizálta
Ezt a kódot futtatom, és megpróbálok áthelyezni egy sort az I. oszlopban megjelenő mai dátum alapján - Megváltoztattam a Range("B1:B" & I) értéket a Range(I1:I" & I) értékre. Módosítottam " Kész" példájában a dátumhoz. Ha azonban a mai dátum bárhol megjelenik a sorban, nem csak az I oszlopban, a sor átkerül az alternatív munkalapra. Bármilyen ötlete, hogy ez miért történik, és hogyan mozgathatom a sort csak akkor, ha a mai dátum az I. oszlopban van, függetlenül attól, hogy a mai dátum megjelenik-e más oszlopokban?
A weboldal moderátora ezt a megjegyzést minimalizálta
Ha sok értéket és sok lapot szeretnék áthelyezni a soromra, akkor az egész kódot újból más értékkel kellene írnom az adott cellához? Vagyis ha NA-t teszek egy cellába akkor Na lapra megy, ha pedig W#-t akkor rossz számlapra stb.
A weboldal moderátora ezt a megjegyzést minimalizálta
szia, ez nagyon hasznos volt. Van erre mód anélkül, hogy az adatsor átkerülne a második lapra, hanem lemásolnák? Tehát mindkét lapon maradnának az adatok?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, a kód nagyon hasznos volt, de a teljes sor másolása helyett megkívánom, hogy egy bizonyos sort át kell helyezni a következő lapra. hogyan definiálhatok egy tartományt egy teljes sor helyett 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").Használttartomány.Sorok.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 then J = 0 End If Set xRg = Worksheets("Sheet1").Tartomány( "C1:C" & I) Hiba esetén Folytatás a következő alkalmazásban.ScreenUpdating = Hamis minden xCell In xRg esetén Ha CStr(xCell.Value) = "Kész" Akkor xCell.Teljes sor.Copy Destination:=Worksheets("Sheet2").Tartomány("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
mi lenne a kód, ha sorokat (meghatározott cellákat) akarok átmásolni egy másik lapra meghatározott cellákba? DE egy érték alapján is Példa: színes termék képek karakterlánc fehér turmixgép 2 fehér turmixgép2 fekete gyümölcscentrifuga 3 feketegyümölcscentrifuga3 piros tv 1 redtv1 zöld vas 4 zöldvas 4 szeretném átmásolni a karakterláncot egy másik lapra, de a képek oszlopában lévő szám azt mutatja, hogy hányszor kell másolni (tehát ebben az esetben a turmixgép karakterlánca 2 sorban kell másolni
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Nagyon szép kódrészlet, nagyon jól működik. Hogyan lehet megváltoztatni ezt a kódot, hogy sorokat helyezzen át egyik táblából a másikba, ahelyett, hogy egyik lapról a másikra kerülne? Nagyon köszönöm !
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, megpróbálom használni a kódot, de szintaktikai hibát kapok a Dim xCell As Range-nél. tudna segíteni kérem?
A weboldal moderátora ezt a megjegyzést minimalizálta
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J A 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").Tartomány("C1:C" & I) Hiba esetén Folytatás Következő Application.ScreenUpdating = Hamis minden xCell esetén az xRg-ben Ha CStr(xCell.Value) = "Kész" Akkor xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Tartomány("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub hogyan lehet egy második munkalapot hozzáadni, hogy a sorok átkerüljenek a 2. lapra?
A weboldal moderátora ezt a megjegyzést minimalizálta
Mit kell megadnom, ha bármilyen dátumot szeretnék megadni értékként? Tehát a sor az 1. munkalapon marad, ha nincs dátuma, és a 2. lapra lép, ha van?
A weboldal moderátora ezt a megjegyzést minimalizálta
[quote]Szia, ez nagyon hasznos volt. Van erre mód anélkül, hogy az adatsor átkerülne a második lapra, hanem lemásolnák? Tehát mindkét lapon maradnának az adatok?Írta: Maddie[/quote] Valaki megoldotta ezt
A weboldal moderátora ezt a megjegyzést minimalizálta
Távolítsa el ezt az „xCell.EntireRow.Delete” elemet a kódból
A weboldal moderátora ezt a megjegyzést minimalizálta
Amikor törlöm ezt a kódsort, és újra futtatom a makrót, az Excel lefagy. Miért és hogyan javítsam meg?? Azt szeretném, ha az adatok mindkét munkalapon szerepelnének, és nem törlődnek az eredetiről. TIA
A weboldal moderátora ezt a megjegyzést minimalizálta
van erre válasz? Az enyém is lefagy, szeretném másolni, de nem törölni a sort
A weboldal moderátora ezt a megjegyzést minimalizálta
Good Day,
Az alábbi VBA-kód segíthet abban, hogy törlés helyett csak másolja a sorokat.

Sub Cheezy ()
Dim xrg mint tartomány
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Munkalapok("1. lap").Használt tartomány.Sorok.Szám
J = Munkalapok("Sheet2").Használt tartomány.Sorok.Szám
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("Sheet2").Used Range) = 0, akkor J = 0
Ha véget
Set xRg = Worksheets("Sheet1").Tartomány("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Hamis
Ha K = 1 - xRg.Count
Ha CStr(xRg(K).Value) = "Kész" Akkor
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Tartomány("A" & J + 1)
J = J + 1
Ha véget
Következő
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Sziasztok, erre keresek valami variációt. Szükségem van arra, hogy a szkript folyamatosan futjon, vagy ennek hiányában, amikor az adott mező értéke megváltozik. Maga a kód működik, de önállóan kell futtatni. Szeretném, ha automatizált lenne. Tud valaki segíteni?

Mellesleg, ha csak azt akarom, hogy a tartomány bizonyos celláira másoljon, hogyan valósítható meg?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Rob!

Ha szüksége van arra, hogy a szkript automatikusan lefusson, amikor a mező cellái megváltoznak, az alábbi VBA-kód segíthet. Kattintson jobb gombbal az aktuális lapra (az automatikusan áthelyezett sorokat tartalmazó lapra), majd válassza a Kód megtekintése lehetőséget a helyi menüből. Ezután másolja ki és illessze be az alábbi VBA-szkriptet a Code ablakba.

Private Sub Worksheet_Change (ByVal Target mint Range)

Dim xCell As Range

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = Hamis

xCell beállítása = Cél(1)
Ha xCell.Value = "Kész" Akkor
I = Munkalapok("2. lap").Használt tartomány.Sorok.Szám
Ha I = 1 Akkor

Ha Application.WorksheetFunction.CountA(Worksheets("Sheet2").Used Range) = 0, akkor I = 0

Ha véget

xCell.EntireRow.Copy Worksheets("Sheet2").Tartomány("A" & I + 1)

xCell.EntireRow.Delete
Ha véget

Application.ScreenUpdating = Igaz

End Sub


A második kérdésedre arra gondolsz, hogy a teljes sor helyett csak több cellát kell másolni? Vagy adnál egy képernyőképet a kérdésedről? Köszönöm!

Üdvözlettel, Crystal
A weboldal moderátora ezt a megjegyzést minimalizálta
Kristály,


Több a segítséged, mint amennyire szüksége van :)



Hogyan adhatunk ide egy másik kritériumot, például szeretném átvinni a Befejezve a Kész mellé:


Private Sub Worksheet_Change (ByVal Target mint Range)

Dim xCell As Range

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = Hamis

xCell beállítása = Cél(1)
Ha xCell.Value = "Kész" Akkor
I = Munkalapok("2. lap").Használt tartomány.Sorok.Szám
Ha I = 1 Akkor

Ha Application.WorksheetFunction.CountA(Worksheets("Sheet2").Used Range) = 0, akkor I = 0

Ha véget

xCell.EntireRow.Copy Worksheets("Sheet2").Tartomány("A" & I + 1)

xCell.EntireRow.Delete
Ha véget

Application.ScreenUpdating = Igaz

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal
Ez a leghasznosabb információ, amit az interneten találtam, és ez a makró azt csinál, amit akarok. De áthelyezem a sorokat egyik táblából a másikba - és ezzel a makróval az információ a táblázaton kívüli első szabad sorba kerül, nem pedig a táblázat következő szabad sorába? Tud segíteni?
A weboldal moderátora ezt a megjegyzést minimalizálta
Ezt a kódot futtatom, és megpróbálok áthelyezni egy sort az I. oszlopban megjelenő mai dátum alapján - Megváltoztattam a Range("B1:B" & I) értéket a Range(I1:I" & I) értékre. Módosítottam " Kész" példájában a dátumhoz. Ha azonban a mai dátum bárhol megjelenik a sorban, nem csak az I oszlopban, a sor átkerül az alternatív munkalapra. Bármilyen ötlete, hogy ez miért történik, és hogyan mozgathatom a sort csak akkor, ha a mai dátum az I. oszlopban van, függetlenül attól, hogy a mai dátum megjelenik-e más oszlopokban?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dávid,

A kód jól működik számomra a tartomány és a változó érték eddigi módosítása után. A kódban szereplő dátumformátumnak meg kell egyeznie a munkalapon használt dátumformátummal. Vagy kényelmes a munkalap csatolása?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,


Nem értem, mire gondolsz, amikor azt mondod, hogy a kód és a táblázat dátumformátumának meg kell egyeznie – nem vagyok VB-szakértő, inkább kezdő. A táblázatomban az F oszlopba a mai dátumot írom be a sor beviteli dátumaként, ctrl + : formátumban. A lejárati dátumot az "I" oszlopba írom be éééé/hh/nn formátumban. Ez azonban problémákat okoz új sor bejegyzéskor és a mai dátum F oszlopba való beírásakor, mert amint beírja, a sor átkerül az új munkalapra. Ezenkívül nem jelenik meg a munkafüzet megnyitásakor lefutó kiegészítő kód. hogy ne kényszerítsem rá. Elnézést, ami nagyon triviális lehet az Ön számára, de egyszerűen nem hallom ezeket a kérdéseket. Bármilyen segítséget szívesen vennénk.
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dávid,

Pontosan úgy próbáltam, ahogy fentebb említetted, de a probléma dózis nem jelenik meg az esetemben. Meg tudod adni az Excel verziódat? További információra van szükségem a probléma megoldásához. Bocsánat, hogy ismét megzavartam.

Üdvözlettel, Crystal
A weboldal moderátora ezt a megjegyzést minimalizálta
Crystal, ezek az érintett munkalapok. Látni fogja a kimásolt kódban, hogy az L oszlopban a "ma dátumig" kifejezést keresem, és ha a "legig" és a mai dátummal együtt szerepel ebben az oszlopban, akkor az ezt a dátumot tartalmazó sort egy új munkalapra szeretném áthelyezni. Jelenleg, ha beírom a mai dátumot bárhová a sorban (például az F oszlopba, ha ma adnak ki felhívást), automatikusan áthelyezi a teljes sort az archivált táblázatba. A mai dátumot általában a ctrl + : kombinációval írom be, általában az F oszlopban.
Ezenkívül szeretném, ha ez a lépés a munkafüzet megnyitásakor történne meg. Jelenleg meg kell mutatnom a kódot, majd meg kell nyomnom az F5 billentyűt. Szívesen vennék minden tanácsot, hogyan kell ezt megtenni.
A weboldal moderátora ezt a megjegyzést minimalizálta
Sajnos a makróképes munkafüzetem nem töltődik fel, mert azt írja, hogy a formátum nem támogatott. Ezek az Excel 2016-ban vannak
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dávid,

A következő VBA-kód segíthet ennek elérésében.

Private Sub Workbook_Open ()
Dim xrg mint tartomány
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Munkalapok ("AKTUÁLIS OÁZIS LEHETŐSÉGEI"). Használt tartomány.Sorok.Szám.
J = Munkalapok ("ARCHIVÁLT OÁZIS LEHETŐSÉGEK"). Használt tartomány.Sorok.Szám.
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Used Range) = 0 Akkor J = 0
Ha véget
Set xRg = Worksheets("CURRENT OASIS LEHETŐSÉGEK").Tartomány("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = Hamis
Minden xCell In xRg
Ha CStr(xCell.Érték) = Dátum Akkor
xCell.EntireRow.Copy Destination:=Munkalapok("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Tartomány("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
Ha véget
Következő
End Sub

Megjegyzések:
1. A VBA-szkriptet be kell helyeznie a ThisWorkbook kódablakába;
2. A munkafüzetet Excel Makró-kompatibilis munkafüzetként kell elmenteni.

A fenti művelet után minden alkalommal, amikor megnyitja a munkafüzetet, egy teljes sor átkerül az ARCHIVÁLT munkalapra, ha az L oszlop cellája eléri a mai dátumot.

Szörnyeteg üdvözlettel, Crystal
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönöm Crystal,
Ez nagyszerűen működik, ha a mai dátumot elérte az L oszlopban. Van-e mód arra, hogy a mai dátumig az L oszlopban is szerepeljen, hogy ha több napig nem nézem meg a munkafüzetet, az automatikusan a korábbi dátumokat is tartalmazza a mai? Nagyon szépen köszönöm a segítséget.
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dávid,

Sajnálom, nem vagyok benne biztos, hogy megkaptam a kérdését. Ha igen, akkor minden sor át lesz helyezve mindaddig, amíg korábbi dátumok szerepelnek az L oszlopban?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal,

Ha néhány napig nem nyitom meg a munkalapomat, és az L oszlopba beírt dátum már elmúlt, azaz az L oszlop cellájában a dátum 11. szeptember 2017., de csak szeptember 13-ig nyitom meg a munkalapomat, mint az L oszlop összes bejegyzését a mai dátumig minden dátumnál ellenőrizni kell, majd helyezze át a megfelelő sorokat az új lapra. Jelenleg a kedvesen megadott kóddal csak azok a sorok kerülnek át az új lapra, amelyekben az L oszlopban az aktuális dátum szerepel, és az L oszlopban korábbi dátummal rendelkezők maradnak, amelyeket jelenleg manuálisan helyezek át az új lapra. Köszönöm a segítséget.
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dávid,



Értem az álláspontodat. Kérjük, próbálja ki az alábbi VBA-szkriptet. A munkafüzet megnyitásakor az L oszlopban a mai dátumig tartó összes sor átkerül az új megadott lapra.



Private Sub Workbook_Open ()
Dim xrg mint tartomány
Dim xRgRtn As Range
Dim xCell As Range
Dim xLastRow As Long
Dim I As Long
Dim J As Long
On Error Resume Next
xLastRow = Munkalapok("AKTUÁLIS OÁZIS LEHETŐSÉGEK").UsedRange.Rows.Count
Ha xLastRow < 1, akkor lépjen ki a Sub-ból
J = Munkalapok ("ARCHIVÁLT OÁZIS LEHETŐSÉGEK"). Használt tartomány.Sorok.Szám.
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Used Range) = 0 Akkor J = 0
Ha véget
Set xRg = Worksheets("AKTUÁLIS OÁZIS LEHETŐSÉGEK").Tartomány("L1:L" & xLastRow)
Ha I = 2 - xLastRow
Ha xRg(I).Érték > Dátum, akkor Lépjen ki a Sub
Ha xRg(I).Érték <= Dátum Akkor
xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Tartomány("A" & J + 1)
xRg(I).EntireRow.Delete
J = J + 1
I = I - 1
Ha véget
Következő
End Sub

A VBA-szkriptet el kell helyeznie a ThisWorkbook kódablakába, és el kell mentenie a munkafüzetet Excel-makró-kompatibilis munkafüzetként.
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönöm Crystal, ez jól működik.
A weboldal moderátora ezt a megjegyzést minimalizálta
Crystal, kissé elhamarkodottan válaszoltam, hogy a kód működött. Ma megnyitottam a munkafüzetet, és az L oszlop cellájában lévő korábbi dátum bejegyzéseket tartalmazó sorok még mindig az "aktuális oázis lehetőségek munkalapon" vannak, és nem kerültek át az "archivált oázis munkalapra" a várt módon. Van valami ötletetek, hogy miért lenne ez így?
A weboldal moderátora ezt a megjegyzést minimalizálta
A kiemelt cellák a fenti kérdésre vonatkozó L oszlopban vannak, és a sor új munkalapra való áthelyezésének kritériumai (a mai napig). Remélhetőleg ez a kép segít.
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez is a fentiekhez kapcsolódó VBA ablak másolata.
A weboldal moderátora ezt a megjegyzést minimalizálta
Crystal, kissé elhamarkodottan válaszoltam, hogy a kód működött. Ma megnyitottam a munkafüzetet, és az L oszlop cellájában lévő korábbi dátum bejegyzéseket tartalmazó sorok még mindig az "aktuális oázis lehetőségek munkalapon" vannak, és nem kerültek át az "archivált oázis munkalapra", ahogy az elvárható volt. Van valami ötletetek, hogy miért lenne ez így?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kristály,

Mivel nem tudom feltölteni a munkafüzetet, itt reprodukálom a sorokat és oszlopokat

ABCDEFGHIJKL
# Típus félreállítási felhívás Módosít # Kiadás dátuma Kérdések Ügyfél szállítási helye Projektjavaslat esedékessége

1 SS SB 1234567 1 09. Nincs Hadsereg neve Hely Hajtástartály 6.

Az alábbi kóddal szeretném, ha egy teljes sort áthelyezne egy új munkalapra, amikor az L oszlop eléri a mai dátumot. Továbbá, ha több napig nem töltöttem ki a munkalapot, akkor szeretném, ha az L oszlopban a "ma dátumig" keresést használja, hogy ugyanezt tegye. Azt is szeretném, ha ez automatikusan megtenné, amikor megnyitom a munkafüzetet, ha lehetséges. Jelenleg, ha a sor bármely cellájába beírom a mai dátumot, például adatbevitelkor az F oszlopba, akkor a teljes sor az archív munkalapra kerül. (Excel 2016 használatával)

[1. modul kód]

Sub DaveV()

Dim xrg mint tartomány

Dim xCell As Range

Dim I As Long

Dim J As Long

I = Munkalapok ("AKTUÁLIS OÁZIS LEHETŐSÉGEI"). Használt tartomány.Sorok.Szám.

J = Munkalapok ("ARCHIVÁLT OÁZIS LEHETŐSÉGEK"). Használt tartomány.Sorok.Szám.

Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Used Range) = 0 Akkor J = 0

Ha véget

Set xRg = Worksheets("CURRENT OASIS LEHETŐSÉGEK").Tartomány("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = Hamis

Minden xCell In xRg

Ha CStr(xCell.Érték) = Dátum Akkor

xCell.EntireRow.Copy Destination:=Munkalapok("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Tartomány("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
Ha véget

Következő
Application.ScreenUpdating = Igaz

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
[1. lap kód]

Private Sub Worksheet_Change (ByVal Target mint Range)
Dim xCell As Range
Dim I As Long
On Error Resume Next
Application.ScreenUpdating = Hamis
xCell beállítása = Cél(1)
Ha xCell.Value = Dátum Akkor
I = Munkalapok ("ARCHIVÁLT OÁZIS LEHETŐSÉGEK"). Használt tartomány.Sorok.Szám.
Ha I = 1 Akkor
If Application.WorksheetFunction.CountA(Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").UsedRange) = 0 Akkor I = 0 End If
xCell.EntireRow.Copy Worksheets("ARCHIVÁLT OÁZIS LEHETŐSÉGEK").Tartomány("A" & I + 1)
xCell.EntireRow.Delete
Ha véget
Application.ScreenUpdating = Igaz
End Sub

Remélem, a fentiek segítenek, de nem vagyok VBA ember, ezért nem értem, hogyan kell a kódot arra késztetni, amire szükségem van. Nagyra értékelnénk a segítségedet.
A weboldal moderátora ezt a megjegyzést minimalizálta
Nagy hiba van a szkriptedben!

Tegyük fel, hogy észlelte, hogy a 7. sorban a „Kész” szó szerepel a C oszlopban, ezért másolja ki és törölje a sort.
Ha törölte a sort, a lista következő sora a 9. sor lesz, és nem a 8., mert miután eltávolította a 7. sort, most a 8. sor tartalma a 7. sorban van, és az összes sor 1 sorral feljebb ment. Tehát a következő ellenőrizendő sornak a 8. sornak kellett volna lennie, de most már tartalmazza azokat az adatokat, amelyek korábban a 9. sorban voltak, tehát minden sor törlésekor valójában kihagy egy sort, hogy ellenőrizze!!!
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Shau Alon!

Köszönjük észrevételét. A kód frissítve a hiba javításával. Köszönöm szépen az asszisztensedet.

Üdvözlettel, Crystal
A weboldal moderátora ezt a megjegyzést minimalizálta
Azt hiszem, ez történik velem, ugyanazt a sort másolja újra és újra, bár azt mondja, hogy a kód frissítve lett. Ez van nálam:

Sub Cheezy ()
„Frissítette a Kutools for Excel 2017/8/28
Dim xrg mint tartomány
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Munkalapok("VÁSÁRLÁSI ELŐREJELZÉS").Használt tartomány.Sorok.Szám.
J = Munkalapok ("Vásárlási archívum"). Használt tartomány.Sorok.Szám.
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("Vásárlási archívum").UsedRange) = 0 Akkor J = 0
Ha véget
Set xRg = Worksheets("VÁSÁRLÁSI ELŐREJELZÉS").Tartomány("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = Hamis
Ha K = 1 - xRg.Count
Ha CStr(xRg(K).Érték) = "Igen" Akkor
xRg(K).EntireRow.Copy Destination:=Worksheets("Vásárlási archívum").Tartomány("A" & J + 1)
xRg(K).EntireRow.Delete
Ha CStr(xRg(K).Érték) = "Igen" Akkor
K = K-1
Ha véget
J = J + 1
Ha véget
Következő
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Fred,
Minden alkalommal, amikor futtatja a kódot, a kód megkeresi a megadott tartományt, így ugyanazt a sort másolja újra és újra, mert nem tudja megállapítani, hogy melyik sort már másolta. Ugyanannak a sornak a többszöri másolásának elkerülése érdekében beállíthatja, hogy a kód automatikusan lefusson, amikor egy megfelelő értéket adnak meg a megadott cellában.
A "VÁSÁRLÁSI ELŐREJELZÉS" nevű munkalapon kattintson jobb gombbal a lapfülre, majd kattintson a gombra Kód megtekintése a helyi menüből. Ezután másolja a következő VBA-kódot a Lap (Kód) ablakba.

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
A weboldal moderátora ezt a megjegyzést minimalizálta
Tudna valaki segíteni nekem, hogy ez működjön? Megpróbáltam megváltoztatni azt a részt, amelynek meg kell egyeznie a fájlommal, de ez megjelenik, és nem tudom, mit tegyek.
A weboldal moderátora ezt a megjegyzést minimalizálta
azt írja ki, hogy a fájl nem támogatott, amikor megpróbálom feltölteni az excel fájlt. Elnézést... ma ezzel küzdök.
A weboldal moderátora ezt a megjegyzést minimalizálta
Segítséget szeretnék kérni hasonló, de kicsit más feladathoz. 5 számoszlopom van, oszloponként körülbelül 25000 1, mindegyik oszlopban 5-1 címsor található. Szeretném a teljes sort átmásolni egy másik lapra, ha az 2. oszlop értéke nagyobb, mint nulla, VAGY a 3. oszlop nagyobb, mint nulla , VAGY a 4. oszlop kisebb, mint nulla, VAGY a 5. oszlop nagyobb, mint öt VAGY az XNUMX. oszlop nagyobb, mint kettő stb. lehetséges ez?
A weboldal moderátora ezt a megjegyzést minimalizálta
nem működik a képfeltöltés... bocsi.
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,
Kérjük, használja ennek a feltöltési gombját.
A weboldal moderátora ezt a megjegyzést minimalizálta
Tehát a cél az, hogy megnézzük, ha valamelyik gáz túllépi-e a képletben beállított határértéket, a teljes ikra átmásolásra kerül egy új lapra.

Köszönöm a segítséget.
A weboldal moderátora ezt a megjegyzést minimalizálta
Kép csatolva
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Michael!
Talán megoldhatja ezt a problémát egy Excel-bővítmény használatával. Itt ajánlom a Kutools for Excel speciális cellák kiválasztása segédprogramját. Ezzel a segédprogrammal könnyedén kijelölheti egy bizonyos tartomány összes sorát, ha egy megadott oszlop értéke nagyobb vagy kisebb, mint egy szám. Az összes szükséges sor kiválasztása után manuálisan másolhatja és beillesztheti őket egy új munkalapra. Lásd az alábbi mellékelt képet.

Erről a funkcióról többet tudhat meg, ha követi az alábbi hivatkozást.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
A weboldal moderátora ezt a megjegyzést minimalizálta
köszönöm ezt a képletet, de volt egy olyan problémám, hogy amikor át akarom helyezni a sort egy másik lapra, az nem történik meg automatikusan. tudnál adni másik képletet? tehát valahányszor megváltoztatom a cella értékét, automatikusan átváltott.


köszönöm
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Janang!
A kód adagolása nem történik meg automatikusan mindaddig, amíg manuálisan nem indítja el a futtatás gombot.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,

Szeretném beállítani ezt a makrót, de 2 érvvel. Sikerült a makrót a fájlomban az O oszlop celláinak értéke alapján működésbe hoznom. Szeretném azonban, ha a makró ellenőrizné, hogy az S oszlop is ki van-e töltve (vagy <> ""), mielőtt áthelyezné a sort. . Végül azt is szeretném, hogy a másolt sorok formátuma megegyezzen a második lap soraival. Ez teljesen megváltoztatja a makrót?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Hugues!
Nem tudom, hogy jól értelek-e. Úgy érted, hogy ha az S oszlop cellája ki van töltve, és az O oszlop cellája egyidejűleg tartalmazza a bizonyos értéket, akkor formázással mozgassa a sort? Különben ne mozdulj?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal!

Igen, pontosan erre gondolok. Valójában az adataim projektekről szólnak. Az O oszlopom a projektem állapota, az S pedig a projektem befejezési dátuma.
Azt akarom, hogy a felhasználóim, akik rendelkeznek az információval, és akiknek be kell őket helyezniük, CSAK akkor tudjanak "archiválni" egy projektet, ha állapotuk "Lezárt", és beillesztették a "Befejezés dátumát".


Remélem ez segít tisztázni a dolgokat
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Hugues!
Elnézést, hogy ilyen későn válaszolok. A következő VBA-kód segíthet a probléma megoldásában. Kérjük, kövesse a cikkben található lépéseket a VBA-szkript alkalmazásához.

Sub MoveRowBasedOnCellValue()
Dim xRgStatus As Range
Dim xRgDate As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Munkalapok("1. lap").Használt tartomány.Sorok.Szám
J = Munkalapok("Sheet2").Használt tartomány.Sorok.Szám
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("Sheet2").Used Range) = 0, akkor J = 0
Ha véget
Set xRgStatus = Worksheets("Sheet1").Tartomány("O1:O" & I)
Set xRgDate = Worksheets("Sheet1").Tartomány("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = Hamis
Application.CutCopyMode = Hamis
xRgStatus(1).EntireRow.Copy
Munkalapok("Sheet2").Tartomány("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Ha K = 2 To xRgStatus.Count
Ha CStr(xRgStatus(K).Value) = "Closed" Akkor
If (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Dátum") Akkor
xRgStatus(K).EntireRow.Copy
Munkalapok("Sheet2").Tartomány("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Ha véget
Ha véget
Következő
Application.CutCopyMode = Igaz
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Crystal!

Nagyon köszönöm a segítséget!

Üdvözlettel,

Hugues
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,


Hogyan másolhatom át a sorokat az áthelyezés helyett?
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,


Tudom, hogy ez már többször megjelent, de nem találom a választ. Hogyan másolhatom át az anyagot az új lapra és NEM törölhetem az eredeti lapról?
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Mike!
Ha törlés helyett másolni szeretné a sorokat, az alábbi VBA kód segíthet. Köszönjük észrevételét!

Sub Cheezy ()
Dim xrg mint tartomány
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Munkalapok("1. lap").Használt tartomány.Sorok.Szám
J = Munkalapok("Sheet2").Használt tartomány.Sorok.Szám
Ha J = 1 Akkor
Ha Application.WorksheetFunction.CountA(Worksheets("Sheet2").Used Range) = 0, akkor J = 0
Ha véget
Set xRg = Worksheets("Sheet1").Tartomány("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Hamis
Ha K = 1 - xRg.Count
Ha CStr(xRg(K).Value) = "Kész" Akkor
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Tartomány("A" & J + 1)
J = J + 1
Ha véget
Következő
Application.ScreenUpdating = Igaz
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,

Új vagyok a makrók használatában, be lehet illeszteni az alábbi adatokat egy bizonyos érték után, és ez az oszlop végéig megismétlődik?
Mint ez:

„Kék” átvitel a „szín” után

A1 = kék
A5 = Szín
A6= (átvigye ide a "Kéket")
stb...
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves John,
Úgy érted, ha egy cellában egy oszlopban a "Szín" van, akkor másolja az első cella szövegét a "Szín" alatti cellába, és ismételje meg a szöveg másolását az oszlop végéig?
Még senki sem írt megjegyzést
Több ingatlan
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi