aducere date de pe alt sheet dupa 1 conditie

Informatii despre cum se utilizeaza Microsoft Excel 2007. Calcule, Formule, Functii, Tabele pivot, Analiza datelor, etc
IPP
Moderator
Moderator
Mesaje: 4196
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: aducere date de pe alt sheet dupa 1 conditie

Mesaj de IPP » Sâm Oct 29, 2011 5:39 pm

Buna ziua

Aveti atasat spre testare un fisier

Obiectiv1: copierea din foaia “Inregistrare” in foaia “Comenzi facute” (doar) a randurilor care au completat cu “Da” celulele de pe coloana D; stergerea acestora din foaia “Inregistrare”
Obiectiv2: copierea din foaia “Comenzi facute” in Foaia “Inregistrare” a randului corespunzator unei celule selectate in prealabil; stergerea randului din foaia “Inregistrare”

Premise: denumirile celor doua foi nu vor fi modificate (in caz contrar va trebui editat si in codul macro)
-coloana B sa fie completata integral (in caz contrar e posibil ca ultimul rand sa nu fie “citit” corect)
-Foaia “Comenzi facute” trebuie sa isi pastreze capul de tabel.

Pentru Obiectiv1 am folosit urmatorul cod:

Cod: Selectaţi tot

Sub MutaComenziEfectuate()

'IPP - 29.10.2011

Application.ScreenUpdating = False

Dim LastRecord As Range
Set LastRecord = Sheets("Inregistrare").Range("B1000000").End(xlUp)

Sheets("Inregistrare").Select
LastRecord.Select

Do Until ActiveCell.Row = 1

If ActiveCell.Offset(0, 2).Value = "Da" Then
    ActiveCell.EntireRow.Copy Destination:=Sheets("Comenzi facute").Range("A1000000").End(xlUp).Offset(1, 0)
    ActiveCell.EntireRow.Delete
End If

ActiveCell.Offset(-1, 0).Select

Loop

Application.ScreenUpdating = True

End Sub
Pentru Obiectiv2 am folosit urmatorul cod:

Cod: Selectaţi tot

Sub MutaComandaGresita()

Selection.EntireRow.Copy Destination:=Sheets("Inregistrare").Range("B1000000").End(xlUp).Offset(1, -1)
Selection.EntireRow.Delete

End Sub
Observatii pentru Obiectiv1:
Datorita modului in care “se deplaseaza” randurile in urma stergerii unuia dintre ele, comanda macro lucreaza dinspre ultimul rand din tabel pana la primul astfel ca nici ordinea de copiere a randurilor in foaia de destinatie nu va fi, probabil, cea “corecta”. In acest caz se poate face sortare ulterioara in functie de criteriile dorite. (La o adica se poate face macro si pentru aceasta operatiune…)

Observatii pentru Obiectiv2:
Se spune despre macrocomenzi ca sunt niste “automatizari” ori acest lucru cam exclude comanda de “Undo” si nu stiu sa existe in VBA un astfel de instrument. Probabil se poate face un cod dar eu inca n-am vazut vreunul.
Asadar macro care incearca se rezolve obiectivul 2, nu face altceva decat sa copieze randul corespunzator celulei selectate in prealabil la sfarsitul tabelului din foaia “Inregistrari” Aici apar urmatoarele probleme: din motive necunoscute mie, informatia astfel copiata NU este vazuta automat de instrumentul Table astfel incat acesta sa se update-teze automat cu noul rand (asa cum ar face daca s-ar scrie informatia de la tastatura) si (pana va veni cineva cu o idee) va trebui sa-l actualizati “manual” prin “tragerea” chenarului si peste noile informatii. Dupa rezolvarea acestei probleme, se poate face o sortare care sa aduca, eventual, randul respectiv in vechea locatie.

Pentru testare:
Deschideti fisierul atasat si activati macro.
Pentru testare Obiectiv1: completati cu “Da” si apasati “butonul” albastru
Pentru testare Obiectiv2; selectati o celula de pe randul pe care il vreti adus inapoi si apasati “butonul” albastru

IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

IPP
Moderator
Moderator
Mesaje: 4196
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: aducere date de pe alt sheet dupa 1 conditie

Mesaj de IPP » Sâm Oct 29, 2011 6:44 pm

Buna ziua

Am modificat al doilea cod care a devenit:

Cod: Selectaţi tot

Sub MutaComandaGresita()

Dim NrRanduri

Selection.EntireRow.Copy Destination:=Sheets("Inregistrare").Range("B1000000").End(xlUp).Offset(1, -1)
Selection.EntireRow.Delete

NrRanduri = Sheets("Inregistrare").Range("B1000000").End(xlUp).Row
Sheets("Inregistrare").ListObjects("Table1").Resize Range("$A$1:$D$" & NrRanduri)

End Sub
Astfel nu va mai trebui sa faceti "manual" update-ul la Table.

IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Închis

Înapoi la “Intrebari despre Excel 2007”