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

Kako premakniti celo vrstico na drug list na podlagi vrednosti celice v Excelu?

Ta članek vam bo pomagal pri premikanju celotne vrstice na drug list na podlagi vrednosti celice.

Premaknite celo vrstico na drug list na podlagi vrednosti celice s kodo VBA
Premaknite celo vrstico na drug list na podlagi vrednosti celice s programom Kutools za Excel


Premaknite celo vrstico na drug list na podlagi vrednosti celice s kodo VBA

Kot je prikazano spodaj na sliki zaslona, ​​morate celotno vrstico premakniti iz Sheet1 na Sheet2, če v stolpcu C. obstaja določena beseda "Končano". Lahko poskusite z naslednjo kodo VBA.

1. Pritisnite druga+ F11 tipke hkrati, da odprete Microsoft Visual Basic za aplikacije okno.

2. V oknu Microsoft Visual Basic for Applications kliknite Vstavi > Moduli. Nato kopirajte in prilepite spodnjo kodo VBA v okno.

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

Opombe: V kodi, Sheet1 je delovni list vsebuje vrstico, ki jo želite premakniti. In Sheet2 je ciljni delovni list, kamor boste poiskali vrstico. “C: C"Je stolpec vsebuje določeno vrednost, beseda"Done"Je določena vrednost, na podlagi katere boste premaknili vrstico. Prosimo, spremenite jih glede na vaše potrebe.

3. Pritisnite F5 tipko za zagon kode, nato pa se vrstica, ki ustreza merilom v listu1, takoj premakne na list2.

Opombe: Zgornja koda VBA bo izbrisala vrstice iz prvotnih podatkov po selitvi na določen delovni list. Če želite vrstice kopirati samo na podlagi vrednosti celice, namesto da bi jih izbrisali. Prosimo, uporabite spodnjo kodo 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

Premaknite celo vrstico na drug list na podlagi vrednosti celice s programom Kutools za Excel

Če ste novinec v kodi VBA. Tukaj predstavljam Izberite Specific Cells uporabnost Kutools za Excel. S tem pripomočkom lahko preprosto izberete vse vrstice na podlagi določene vrednosti celice ali različnih vrednosti celic na delovnem listu in izbrane vrstice kopirate na ciljni delovni list, kot potrebujete. Naredite naslednje.

Pred vložitvijo vloge Kutools za ExcelProsim najprej ga prenesite in namestite.

1. Izberite seznam stolpcev, ki vsebuje vrednost celice, na podlagi katere boste premaknili vrstice, in kliknite Kutools > Izberite > Izberite Specific Cells. Oglejte si posnetek zaslona:

2. Na odprtju Izberite Specific Cells izberite pogovorno okno Cela vrstica v Vrsta izbire izberite, izberite enako v Posebna vrsta spustni seznam, vnesite vrednost celice v besedilno polje in nato kliknite OK gumb.

Še ena Izberite Specific Cells Pojavi se pogovorno okno, da se prikaže število izbranih vrstic, medtem ko vse vrstice vsebujejo določeno vrednost, v izbranem stolpcu pa so bile izbrane. Oglejte si posnetek zaslona:

3. Pritisnite Ctrl + C tipke za kopiranje izbranih vrstic in jih nato prilepite v ciljni delovni list, ki ga potrebujete.

Opombe: Če želite premakniti vrstice na drug delovni list, ki temelji na dveh različnih vrednostih celic. Če na primer premaknete vrstice glede na vrednosti celic "Končano" ali "Obdelava", lahko omogočite Or stanje v Izberite Specific Cells pogovorno okno, kot je prikazano spodaj:

  Če želite imeti brezplačen preizkus (30-dan) tega pripomočka, kliknite, če ga želite prenestiin nato nadaljujte z uporabo postopka v skladu z zgornjimi koraki.


Sorodni članki:


Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize
Komentarji (299)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, ta vodnik se mi je zdel zelo koristen v primerjavi z drugimi, ki sem jih videl. Hvala vam! Težava, ki jo imam, je, da če spremenim želeno vrednost v "Zaprto", moram zagnati F5, da premaknem vrstico. Rad bi, da se premakne samodejno. Sem nov v Excelu, zato je vaša pomoč zelo cenjena. 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("Resolved Issues").UsedRange.Rows. Count If J = 1 Potem Če Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 Potem J = 0 Konec, če je nastavljen xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) Ob napaki Nadaljuj naslednjo aplikacijo.ScreenUpdating = False For Every xCell In xRg Če CStr(xCell.Value) = "Zaprto" Potem xCell.EntireRow.Copy Destination:=Worksheets("Resolved Issues").Range("A") & J + 1) xCell.EntireRow.Delete J = J + 1 End, če je naslednja aplikacija.ScreenUpdating = True End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, poskušam avtomatizirati premikanje celic, ne da bi bilo treba odpreti modul in pritisniti tudi F5. Ste že kdaj rešili to vprašanje? Hvala v naprej!
Ta komentar je moderator na spletnem mestu minimiziral
Crystal je zagotovila informacije o tem, kako to storiti danes - poglejte prvo stran te teme, da vidite njen odgovor. Samodejno premakne vrstico z današnjim datumom v stolpcu (v mojem primeru L) na drug delovni list.
Ta komentar je moderator na spletnem mestu minimiziral
Izvajam to kodo in poskušam premakniti vrstico na podlagi današnjega datuma, ki se pojavi v stolpcu I - spremenil sem Range("B1:B" & I), da bere Range(I1:I" & I) . Spremenil sem " Končano" v vašem primeru na datum. Vendar, ko se današnji datum prikaže kjer koli v vrstici, ne le v stolpcu I, kot je zahtevano, se vrstica premakne na nadomestni delovni list. Vsekakor se zdi, zakaj se to dogaja in kako lahko premaknem vrstico samo, ko je današnji datum v stolpcu I, ne glede na to, ali je današnji datum v drugih stolpcih?
Ta komentar je moderator na spletnem mestu minimiziral
Če bi želel imeti veliko vrednosti in veliko listov, na katere bi premaknil svojo vrstico, bi moral ponovno napisati celotno kodo z drugačno vrednostjo za to celico? To pomeni, da če vnesem NA v eno celico, gre na list Na, in če dam W#, bo šel na napačno številko lista itd.
Ta komentar je moderator na spletnem mestu minimiziral
zdravo, to je bilo zelo koristno. Ali obstaja način, da to storite, ne da bi se vrstica podatkov premaknila na drugi list, temveč da bi bila kopirana? Torej bi podatki ostali na obeh listih?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, koda je bila zelo koristna, vendar namesto kopiranja celotne vrstice zahtevam, da se določen izbor vrstice premakne na naslednji list. kako lahko definiram obseg namesto celotne vrstice 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 Če je J = 1 Potem Če Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Potem J = 0 Konec, če nastavite xRg = Worksheets("Sheet1").Range( "C1:C" & I) Ob napaki Nadaljuj z naslednjim Application.ScreenUpdating = False For Every xCell In xRg Če je CStr(xCell.Value) = "Done", potem xCell.Celotna vrstica.Destinacija kopiranja:=Delovni listi("Sheet2").Range("A" & J + 1) J = J + 1 Konec, če je naslednja aplikacija.ScreenUpdating = True End Sub
Ta komentar je moderator na spletnem mestu minimiziral
kakšna bi bila koda, če želim kopirati vrstice (določene celice) na drug list v določene celice? AMPAK tudi na podlagi vrednosti Primer: niz barvnih slik izdelkov beli mešalnik 2 whiteblender2 črni sokovnik 3 blackjuicer3 rdeči tv 1 redtv1 zeleno železo 4 greeniron4 Rad bi, da se niz kopira na drug list, vendar številka v stolpcu s slikami pove, kolikokrat ga je treba kopirati (torej v tem primeru vrvica mešalnika je treba kopirati v 2 vrstici
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, zelo lep kos kode, deluje zelo dobro. Kako spremeniti to kodo za premikanje vrstic iz ene tabele v drugo tabelo, namesto iz enega lista v drugega? Najlepša hvala !
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, poskušam uporabiti kodo, vendar dobim napako v sintaksi na Dim xCell As Range. Ali lahko pomagate prosim?
Ta komentar je moderator na spletnem mestu minimiziral
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 Nato Če Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Potem J = 0 Konec Če nastavite xRg = Worksheets("Sheet1").Range("C1:C" & I) Ob napaki Nadaljuj Naslednja Application.ScreenUpdating = False For Every xCell In xRg Če je CStr(xCell.Value) = "Done" Potem xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub, kako lahko dodate drugi delovni list, da se vrstice premaknejo na list2?
Ta komentar je moderator na spletnem mestu minimiziral
Kaj naj vnesem, če želim vključiti kateri koli datum kot svojo vrednost? Torej vrstica ostane na listu 1, če nima datuma, in se premakne na list 2, če ima?
Ta komentar je moderator na spletnem mestu minimiziral
[quote]zdravo, to je bilo zelo koristno. Ali obstaja način, da to storite, ne da bi se vrstica podatkov premaknila na drugi list, temveč da bi bila kopirana? Torej bi podatki ostali na obeh listih?Avtor Maddie[/quote] je kdo to rešil
Ta komentar je moderator na spletnem mestu minimiziral
Odstranite to "xCell.EntireRow.Delete" iz kode
Ta komentar je moderator na spletnem mestu minimiziral
Ko izbrišem to vrstico kode in znova zaženem makro, Excel zamrzne. Zakaj in kako to popravim?? Želim, da so podatki na obeh delovnih listih in da se ne brišejo iz izvirnika. TIA
Ta komentar je moderator na spletnem mestu minimiziral
ali obstaja odgovor na to? Tudi moj zamrzne. Rad bi kopiral, vendar ne bi izbrisal vrstice
Ta komentar je moderator na spletnem mestu minimiziral
Dober dan,
Spodnja koda VBA vam lahko pomaga samo kopirati vrstice, namesto da jih izbrišete.

Sub Cheezy ()
Dim xRg As Range
Zatemni xCell kot obseg
Dim I As Long
Dim J Tako dolgo
Dim K As Long
I = Delovni listi("Sheet1").UsedRange.Rows.Count
J = Delovni listi("Sheet2").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, potem je J = 0
Konec Če
Nastavi xRg = Delovni listi("List1").Razpon("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Napačno
Za K = 1 To xRg.Count
Če je CStr(xRg(K).Value) = "Končano" Potem
xRg(K).EntireRow.Destination:=Delovni listi("Sheet2").Range("A" & J + 1)
J = J + 1
Konec Če
Naslednji
Application.ScreenUpdating = Res
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, iščem različico tega. Potrebujem, da se skript izvaja neprekinjeno ali da to ne uspe, kadar se vrednost v tem določenem polju spremeni. Sama koda deluje, vendar jo je treba izvajati neodvisno. Rad bi, da bi bilo avtomatizirano. Ali lahko kdo pomaga?

Na stran, če želim, da kopira samo določene celice v obsegu, kako je to doseženo?
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Rob,

Če želite, da se skript samodejno zažene, ko se celice v tem polju spremenijo, vam lahko pomaga spodnja koda VBA. Z desno miškino tipko kliknite zavihek trenutni list (list z vrsticami, ki jih boste samodejno premaknili), nato v kontekstnem meniju izberite Ogled kode. Nato kopirajte in prilepite spodnji skript VBA v okno kode.

Zasebni poddelovni list_Spremeni (ByVal Target As Range)

Zatemni xCell kot obseg

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = Napačno

Nastavi xCell = Target(1)
Če je xCell.Value = "Končano" Potem
I = Delovni listi("Sheet2").UsedRange.Rows.Count
Če je I = 1 Potem

Če je Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, potem je I = 0

Konec Če

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

xCell.EntireRow.Delete
Konec Če

Application.ScreenUpdating = Res

End Sub


Za vaše drugo vprašanje, ali mislite samo kopirati več celic namesto celotne vrstice? Ali pa prosim priložite posnetek zaslona svojega vprašanja? Hvala vam!

Lep pozdrav, Crystal
Ta komentar je moderator na spletnem mestu minimiziral
kristal,


Vaša pomoč je več kot potrebna :)



Kako lahko tukaj dodamo še eno merilo, na primer želim prenesti Dokončano poleg Končano:


Zasebni poddelovni list_Spremeni (ByVal Target As Range)

Zatemni xCell kot obseg

Dim I As Long
On Error Resume Next

Application.ScreenUpdating = Napačno

Nastavi xCell = Target(1)
Če je xCell.Value = "Končano" Potem
I = Delovni listi("Sheet2").UsedRange.Rows.Count
Če je I = 1 Potem

Če je Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, potem je I = 0

Konec Če

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

xCell.EntireRow.Delete
Konec Če

Application.ScreenUpdating = Res

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal
To je najbolj uporabna informacija, ki sem jo našel na spletu, in ta makro dela, kar želim. Toda premikam vrstice iz ene tabele v drugo tabelo - in s tem makrom se informacije premaknejo iz prve proste vrstice zunaj tabele, ne iz naslednje proste vrstice v tabeli? Lahko pomagate?
Ta komentar je moderator na spletnem mestu minimiziral
Izvajam to kodo in poskušam premakniti vrstico na podlagi današnjega datuma, ki se pojavi v stolpcu I - spremenil sem Range("B1:B" & I), da bere Range(I1:I" & I) . Spremenil sem " Končano" v vašem primeru na datum. Vendar, ko se današnji datum prikaže kjer koli v vrstici, ne le v stolpcu I, kot je zahtevano, se vrstica premakne na nadomestni delovni list. Vsekakor se zdi, zakaj se to dogaja in kako lahko premaknem vrstico samo, ko je današnji datum v stolpcu I, ne glede na to, ali je današnji datum v drugih stolpcih?
Ta komentar je moderator na spletnem mestu minimiziral
Dragi David,

Koda mi dobro deluje po spremembi obsega in vrednosti spremenljivke do danes. Oblika datuma v vaši kodi se mora ujemati z obliko datuma, ki ste jo uporabili na delovnem listu. Ali pa je priročno, da priložite svoj delovni list?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal,


Ni mi jasno, kaj mislite, ko pravite, da se morajo formati datuma kode in preglednice ujemati - nisem strokovnjak za VB, ampak bolj novinec. V mojo preglednico vnesem današnji datum v stolpec F kot datum vnosa vrstice v obliki ctrl + :. Datum poteka vpišem v stolpec "I" v formatu mm/dd/llll. Vendar to povzroča težave pri vnosu nove vrstice in vnašanju današnjega datuma v stolpec F, ker se vrstica takoj, ko je vnesena, premakne na nov delovni list. Poleg tega se ne prikaže dodatna koda, ki se zažene vsakič, ko se delovni zvezek odpre. da teče, ne da bi ga jaz prisilil v to. Opravičujem se za zelo nepomembne težave, vendar se o teh vprašanjih preprosto ne morem slišati. Vsaka pomoč bi bila hvaležna.
Ta komentar je moderator na spletnem mestu minimiziral
Dragi David,

Preizkusil sem točno to, kar ste omenili zgoraj, vendar se v mojem primeru težava ne pojavi. Ali lahko zagotovite svojo različico Excela? Potrebujem več informacij za pomoč pri reševanju te težave. Oprostite, da vas spet motim.

Lep pozdrav, Crystal
Ta komentar je moderator na spletnem mestu minimiziral
Crystal, to so zadevni delovni listi. V kopirani kodi boste videli, da iščem "do " današnji datum v stolpcu L in če je "do" in vključno z današnjim datumom v tem stolpcu, želim premakniti vrstico, ki vsebuje ta datum, na nov delovni list. Trenutno, ko vnesem današnji datum kjer koli v vrstico (na primer stolpec F, če je razpis izdano danes), samodejno premakne celotno vrstico v arhivirano preglednico. Današnji datum običajno vnesem s kombinacijo ctrl + :, običajno v stolpcu F.
Poleg tega bi rad, da se ta poteza zgodi, ko odprem delovni zvezek. Trenutno moram iti na prikaz kode in nato pritisniti F5. Vsak nasvet, kako to narediti, bi bil dobrodošel.
Ta komentar je moderator na spletnem mestu minimiziral
Žal se moj delovni zvezek, ki podpira makre, ne bo naložil, saj piše, da format ni podprt. Ti so v Excelu 2016
Ta komentar je moderator na spletnem mestu minimiziral
Dragi David,

Pri tem vam lahko pomaga naslednja koda VBA.

Zasebni delovni zvezek_Open()
Dim xRg As Range
Zatemni xCell kot obseg
Dim I As Long
Dim J Tako dolgo
I = Delovni listi ("TRENUTNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count
J = Delovni listi ("ARHIVNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("ARHIVNE OAZIS PRILOŽNOSTI").UsedRange) = 0, potem je J = 0
Konec Če
Nastavite xRg = Delovni listi("TRUTNE PRILOŽNOSTI OAZIS").Razpon("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = Napačno
Za vsako xCell In xRg
Če je CStr(xCell.Value) = Datum Potem
xCell.EntireRow.Copy Destination:=Delovni listi("ARHIVNE MOŽNOSTI OAZIS").Razpon("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
Konec Če
Naslednji
End Sub

Opombe:
1. V okno kode ThisWorkbook morate vnesti skript VBA;
2. Vaš delovni zvezek morate shraniti kot Excelov delovni zvezek z omogočenimi makri.

Po zgornji operaciji se vsakič, ko odprete delovni zvezek, celotna vrstica premakne na ARHIVIRAN delovni list, če celica v stolpcu L doseže današnji datum.

Lep pozdrav, Crystal
Ta komentar je moderator na spletnem mestu minimiziral
Hvala Crystal,
To deluje odlično, če je današnji datum dosežen v stolpcu L. Ali obstaja kakršen koli način, da v stolpec L vključimo tudi današnji datum, tako da, če več dni ne preverim delovnega zvezka, bo samodejno vključil prejšnje datume pred današnji? Najlepša hvala za vašo pomoč.
Ta komentar je moderator na spletnem mestu minimiziral
Dragi David,

Oprostite, nisem prepričan, da sem dobil vaše vprašanje. Če je tako, bodo vse vrstice premaknjene, dokler se v stolpcu L pojavljajo prejšnji datumi?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal,

Če svojega delovnega lista ne odprem nekaj dni in je datum, vpisan v stolpcu L, zdaj potekel, tj. datum v celici v stolpcu L je 11. september 2017, vendar svojega delovnega lista ne odprem do 13. septembra, bi tako kot vsi vnosi v stolpcu L, ki jih je treba preveriti za vsak datum do današnjega datuma, nato premaknite ustrezne vrstice na nov list. Trenutno se s kodo, ki ste jo prijazno posredovali, na nov list premaknejo samo vrstice s trenutnim datumom v stolpcu L, za seboj pa ostanejo tiste s starejšim datumom v stolpcu L, ki jih trenutno ročno premaknem na nov list. Hvala za vašo pomoč.
Ta komentar je moderator na spletnem mestu minimiziral
Dragi David,



Razumem tvojo poanto. Poskusite spodnji skript VBA. Ko odprete delovni zvezek, bodo vse vrstice z datumi do današnjega datuma v stolpcu L premaknjene na nov določen list.



Zasebni delovni zvezek_Open()
Dim xRg As Range
Dim xRgRtn kot obseg
Zatemni xCell kot obseg
Zatemni xLastRow tako dolgo
Dim I As Long
Dim J Tako dolgo
On Error Resume Next
xLastRow = Delovni listi ("TRENUTNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count
Če je xLastRow < 1, potem zapustite Sub
J = Delovni listi ("ARHIVNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("ARHIVNE OAZIS PRILOŽNOSTI").UsedRange) = 0, potem je J = 0
Konec Če
Nastavite xRg = Delovni listi ("TRENUTNE PRILOŽNOSTI OAZIS").Razpon("L1:L" & xLastRow)
Za I = 2 do xLastRow
Če xRg(I).Value > Date, potem Izhod iz Sub
Če je xRg(I).Vrednost <= Datum Potem
xRg(I).EntireRow.Destination:=Delovni listi("ARHIVNE PRILOŽNOSTI OAZIS").Razpon("A" & J + 1)
xRg(I).Celotna vrstica.Izbriši
J = J + 1
jaz = jaz - 1
Konec Če
Naslednji
End Sub

Skript VBA morate vnesti v okno kode ThisWorkbook in delovni zvezek shraniti kot delovni zvezek z omogočenimi makri Excel.
Ta komentar je moderator na spletnem mestu minimiziral
Hvala Crystal, deluje čisto v redu.
Ta komentar je moderator na spletnem mestu minimiziral
Crystal, malo sem bil prenagljen z odgovorom, da koda deluje. Danes sem odprl svoj delovni zvezek in vrstice, ki vsebujejo predhodne datumske vnose v celici stolpca L, so še vedno v "delovnem listu trenutnih priložnosti za oazo" in se po pričakovanjih niso premaknile na "arhivirani delovni list oaze". Kakšne ideje, zakaj bi bilo tako?
Ta komentar je moderator na spletnem mestu minimiziral
Označene celice so v stolpcu L glede na zgornje vprašanje in so merila (do današnjega datuma) za premikanje vrstice na nov delovni list. Upam, da bo ta slika pomagala.
Ta komentar je moderator na spletnem mestu minimiziral
To je tudi kopija okna VBA, povezanega z zgornjim.
Ta komentar je moderator na spletnem mestu minimiziral
Crystal, malo sem bil prenagljen z odgovorom, da koda deluje. Danes sem odprl svoj delovni zvezek in vrstice, ki vsebujejo predhodne datumske vnose v stolpcu L celici, so še vedno v "delovnem listu trenutnih možnosti oaze" in se niso premaknile na "arhivirani delovni list oaze", kot je bilo pričakovano. Kakšne ideje, zakaj bi bilo tako?
Ta komentar je moderator na spletnem mestu minimiziral
kristal,

Ker ne morem naložiti svojega delovnega zvezka, bom tukaj reproducirala vrstice in stolpce

ABCDEFGHIJKL
# Vrsta Poziv za praho Sprememba # Datum izdaje Vprašanja Odjemalec Mesto dostave Predlog projekta Rok

1 SS SB 1234567 1 09/6/17 Št. Army Name Kraj Pogon tank 09/10/17

S spodnjo kodo želim, da premakne celotno vrstico na nov delovni list, ko stolpec L doseže današnji datum. Če delovnega lista nisem dokončal več dni, bi želel, da uporabi iskanje "do današnjega datuma" v stolpcu L, da naredi isto. Želel bi tudi, da bi to storilo samodejno, ko odprem delovni zvezek, če je mogoče. Če trenutno vnesem današnji datum v katero koli celico v vrstici, na primer stolpec F pri vnosu podatkov, se celotna vrstica premakne na arhivski delovni list. (Z uporabo Excela 2016)

[Koda 1. modula]

Sub DaveV()

Dim xRg As Range

Zatemni xCell kot obseg

Dim I As Long

Dim J Tako dolgo

I = Delovni listi ("TRENUTNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count

J = Delovni listi ("ARHIVNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count

Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("ARHIVNE OAZIS PRILOŽNOSTI").UsedRange) = 0, potem je J = 0

Konec Če

Nastavite xRg = Delovni listi("TRUTNE PRILOŽNOSTI OAZIS").Razpon("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = Napačno

Za vsako xCell In xRg

Če je CStr(xCell.Value) = Datum Potem

xCell.EntireRow.Copy Destination:=Delovni listi("ARHIVNE MOŽNOSTI OAZIS").Razpon("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
Konec Če

Naslednji
Application.ScreenUpdating = Res

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
[Šifra 1. lista]

Zasebni poddelovni list_Spremeni (ByVal Target As Range)
Zatemni xCell kot obseg
Dim I As Long
On Error Resume Next
Application.ScreenUpdating = Napačno
Nastavi xCell = Target(1)
Če je xCell.Value = Datum Potem
I = Delovni listi ("ARHIVNE PRILOŽNOSTI OAZIS").UsedRange.Rows.Count
Če je I = 1 Potem
Če Application.WorksheetFunction.CountA(Worksheets("ARHIVIRANI OAZIS PRILOŽNOSTI").UsedRange) = 0 Potem I = 0 Konec Če
xCell.EntireRow.Copy Worksheets("ARHIVNE MOŽNOSTI OAZIS").Razpon("A" & I + 1)
xCell.EntireRow.Delete
Konec Če
Application.ScreenUpdating = Res
End Sub

Upam, da je zgornje pomagalo, vendar nisem oseba VBA, zato ne razumem, kako narediti kodo, kar potrebujem. Vaša pomoč bi bila cenjena.
Ta komentar je moderator na spletnem mestu minimiziral
V tvojem scenariju je velika napaka!

Recimo, da ste zaznali, da ima vrstica 7 besedo "Končano" v stolpcu C, zato jo kopirate in izbrišete vrstico.
Ko ste izbrisali vrstico, bo naslednja vrstica na seznamu vrstica 9 in ne 8, ker ko ste odstranili 7. vrstico, je zdaj vsebina 8. vrstice v vrstici 7, vse vrstice pa so šle navzgor za 1 vrstico. Torej bi morala biti naslednja vrstica za preverjanje vrstica #8, zdaj pa vsebuje podatke, ki so bili prej v vrstici #9, tako da vsakič, ko brišete vrstico, dejansko preskočite vrstico za preverjanje!!!
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Shau Alon,

Hvala za vaš komentar. Koda je bila posodobljena z odpravljeno napako. Najlepša hvala za vašega pomočnika.

Lep pozdrav, Crystal
Ta komentar je moderator na spletnem mestu minimiziral
Mislim, da se to dogaja meni, vedno znova kopira isto vrstico, čeprav piše, da je bila koda posodobljena. Tole imam:

Sub Cheezy ()
'Posodobljeno s Kutools za Excel 2017/8/28
Dim xRg As Range
Zatemni xCell kot obseg
Dim I As Long
Dim J Tako dolgo
Dim K As Long
I = Delovni listi("PURCHASE FORCAST").UsedRange.Rows.Count
J = Delovni listi ("Arhiv nakupov").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0, potem je J = 0
Konec Če
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = Napačno
Za K = 1 To xRg.Count
Če je CStr(xRg(K).Vrednost) = "Da" Potem
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).Celotna vrstica.Izbriši
Če je CStr(xRg(K).Vrednost) = "Da" Potem
K = K - 1
Konec Če
J = J + 1
Konec Če
Naslednji
Application.ScreenUpdating = Res
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Hi Fred,
Vsakič, ko zaženete kodo, koda išče navedeni obseg, tako da vedno znova kopira isto vrstico, ker ne more ugotoviti, katera vrstica je že bila kopirana. Če se želite izogniti večkratnemu kopiranju iste vrstice, lahko nastavite kodo, ki se samodejno zažene, ko je v podano celico vnesena ujemajoča se vrednost.
Na delovnem listu z imenom "PURCHASE FORCAST" z desno miškino tipko kliknite zavihek lista in kliknite Ogled kode iz kontekstnega menija. Nato kopirajte naslednjo kodo VBA v okno Sheet (Code).

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
Ta komentar je moderator na spletnem mestu minimiziral
Mi lahko kdo pomaga, da to deluje? Poskušal sem spremeniti del, ki se mora ujemati z mojo datoteko, vendar se to pojavi in ​​ne vem, kaj naj storim.
Ta komentar je moderator na spletnem mestu minimiziral
piše, da datoteka ni podprta, ko poskušam naložiti excel datoteko. Oprosti ... danes se borim s tem.
Ta komentar je moderator na spletnem mestu minimiziral
Prosil bi za pomoč za podobno nalogo, vendar nekoliko drugačno. Imam 5 stolpcev številk, približno 25000 na stolpec, vsak stolpec z naslovom 1-5. Rad bi kopiral celotno vrstico na drug list, če je vrednost stolpca 1 velika od nič, ALI stolpec 2 je večji od nič , ALI stolpec 3 je manjši od nič, ALI stolpec 4 je velik od petih ALI stolpec 5 je večji od dva itd. ali je to mogoče?
Ta komentar je moderator na spletnem mestu minimiziral
nalaganje slike ne deluje ... žal.
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo,
Prosimo, uporabite gumb za nalaganje tega.
Ta komentar je moderator na spletnem mestu minimiziral
Torej je cilj videti, če je kateri od plinov čez mejo, ki jo bom postavil v formuli, celotna ikra se KOPIRA na nov list.

Najlepša hvala za kakršno koli pomoč.
Ta komentar je moderator na spletnem mestu minimiziral
Slika priložena
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Michael,
Morda lahko to težavo rešite z uporabo Excelovega dodatka. Tukaj vam priporočam pripomoček za izbiro posebnih celic Kutools za Excel. S tem pripomočkom lahko preprosto izberete vse vrstice v določenem obsegu, če je vrednost določenega stolpca večja ali manjša od števila. Ko izberete vse potrebne vrstice, jih lahko ročno kopirate in prilepite na nov delovni list. Glej spodnjo priloženo sliko.

Več o tej funkciji lahko izveste tako, da sledite spodnji hiperpovezavi.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Ta komentar je moderator na spletnem mestu minimiziral
hvala za to formulo, vendar sem imel težavo, ko želim premakniti vrstico na drug list, se to ne zgodi samodejno. mi lahko daš drugo formulo? tako da vsakič, ko spremenim vrednost celice, se je premaknila samodejno.


hvala
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Janang,
Odmerek kode se ne zgodi samodejno, dokler ročno ne sprožite gumba za zagon.
Ta komentar je moderator na spletnem mestu minimiziral
Hi,

Rad bi imel ta makro nastavljen, vendar z 2 argumentoma. Uspelo mi je, da makro deluje v moji datoteki na podlagi vrednosti celic v stolpcu O. Vendar bi rad, da makro preveri, ali je tudi stolpec S izpolnjen (ali <> ""), preden premakne vrstico . Nazadnje bi rad tudi, da so kopirane vrstice enakega formata kot vrstice na drugem listu. Ali to popolnoma spremeni makro?
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Hugues,
Ne vem, če te prav razumem. Mislite, da če je celica v stolpcu S izpolnjena in celica v stolpcu O vsebuje določeno vrednost hkrati, potem premaknite vrstico z oblikovanjem? Sicer se ne premakneš?
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni Crystal,

Ja, točno to mislim. Pravzaprav so moji podatki o projektih. Moj stolpec O je stanje mojega projekta, S pa končni datum mojega projekta.
Želim, da moji uporabniki, ljudje, ki imajo informacije in jih bodo morali vnesti, lahko "Arhivirajo" projekt SAMO, če imajo status "Zaprt" in so vstavili "Končni datum".


Upam, da bo to pomagalo razjasniti stvari
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Hugues,
Oprostite za tako pozen odgovor. Naslednja koda VBA vam lahko pomaga rešiti težavo. Sledite korakom v tem članku, da uporabite skript VBA.

Sub MoveRowBasedOnCellValue()
Zatemni xRgStatus kot obseg
Zatemni xRgDate kot obseg
Dim I As Long
Dim J Tako dolgo
Dim K As Long
I = Delovni listi("Sheet1").UsedRange.Rows.Count
J = Delovni listi("Sheet2").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, potem je J = 0
Konec Če
Nastavi xRgStatus = Delovni listi("Sheet1").Range("O1:O" & I)
Nastavi xRgDate = Delovni listi("Sheet1").Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = Napačno
Application.CutCopyMode = Napačno
xRgStatus(1).EntireRow.Copy
Delovni listi("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Za K = 2 Do xRgStatus.Count
Če je CStr(xRgStatus(K).Value) = "Zaprto" Potem
Če (xRgDate(K).Value <> "") In (TypeName(xRgDate(K).Value) = "Date") potem
xRgStatus(K).Celotna Vrstica.Kopiraj
Delovni listi("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Konec Če
Konec Če
Naslednji
Application.CutCopyMode = True
Application.ScreenUpdating = Res
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Draga Crystal,

Najlepša hvala za vašo pomoč!

S spoštovanjem,

Hugues
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo,


Kako kopiram vrstice, namesto da jih premikam?
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo,


Vem, da je bilo to že nekajkrat objavljeno, vendar ne najdem odgovora. Kako lahko kopiram gradivo na nov list in ga NE izbrišem iz izvirnega lista?
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Mike,
Če želite kopirati vrstice, namesto da jih izbrišete, vam lahko pomaga spodnja koda VBA. Hvala za vaš komentar!

Sub Cheezy ()
Dim xRg As Range
Zatemni xCell kot obseg
Dim I As Long
Dim J Tako dolgo
Dim K As Long
I = Delovni listi("Sheet1").UsedRange.Rows.Count
J = Delovni listi("Sheet2").UsedRange.Rows.Count
Če je J = 1 Potem
Če je Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0, potem je J = 0
Konec Če
Nastavi xRg = Delovni listi("List1").Razpon("C1:C" & I)
On Error Resume Next
Application.ScreenUpdating = Napačno
Za K = 1 To xRg.Count
Če je CStr(xRg(K).Value) = "Končano" Potem
xRg(K).EntireRow.Destination:=Delovni listi("Sheet2").Range("A" & J + 1)
J = J + 1
Konec Če
Naslednji
Application.ScreenUpdating = Res
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Hi,

Sem nov pri uporabi makrov, ali je mogoče spodnje podatke prilepiti po določeni vrednosti in se bodo ponavljali do konca stolpca?
Všečkaj to:

Prenesite "Modro" za "Barvo"

A1 = modra
A5= Barva
A6= (tukaj prenesite "modro")
in tako naprej...
Ta komentar je moderator na spletnem mestu minimiziral
Dragi John,
Ali mislite, če celica vsebuje "Barva" v stolpcu, potem kopirajte besedilo prve celice v celico pod "Barvo" in ponovite kopiranje tega besedila do konca stolpca?
Tu še ni objavljenih komentarjev
Obremenitev Več
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL