Buna am nevoie de ajutorul vostru
-
- Mesaje: 10
- Membru din: Joi Iun 22, 2017 2:56 pm
Re: Buna am nevoie de ajutorul vostru
Multumesc frumos
Functioneaza perfect !!!!
O echipa superba felicitari !
Functioneaza perfect !!!!
O echipa superba felicitari !
Re: Buna am nevoie de ajutorul vostru
Buna,
Am o nedumerire: de ce se copiaza valorile din Diferente inventar.xlsm, Sheet 1, in foile cu "Valori cu + si -" ca apoi de aici sa fie copiate in fisierul destinatie?
Nu era mai simplu sa se copieze acele date direct in fisierul destinatie si apoi sa se copieze datele in foile cu valorile cu "+" si "-".
Exista vreo explicatie logica?
Daca nu exista, atunci codul lui IPP se poate "restrange" la:
Am o nedumerire: de ce se copiaza valorile din Diferente inventar.xlsm, Sheet 1, in foile cu "Valori cu + si -" ca apoi de aici sa fie copiate in fisierul destinatie?
Nu era mai simplu sa se copieze acele date direct in fisierul destinatie si apoi sa se copieze datele in foile cu valorile cu "+" si "-".
Exista vreo explicatie logica?
Daca nu exista, atunci codul lui IPP se poate "restrange" la:
Cod: Selectaţi tot
Sub CopiereConditionata_2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim myPath As String
myPath = ThisWorkbook.Path
Dim fDestin As String
fDestin = "Model Fisier Inventar.xlsx"
Dim myRng As Range
Set myRng = Sheets("Sheet1").Range("A1").CurrentRegion.Offset(1, 0).Columns(5).Cells
For Each c In myRng
If c.Value < 0 Then
c.EntireRow.Copy Destination:=Sheets("Valorile cu -").Range("A1000000").End(xlUp).Offset(1, 0)
Else
c.EntireRow.Copy Destination:=Sheets("Valorile cu +").Range("A1000000").End(xlUp).Offset(1, 0)
End If
Next c
Application.CutCopyMode = False
Workbooks.Open Filename:=myPath & "\" & fDestin
Sheets("Sheet1").Select
With ThisWorkbook.Sheets(1).Range("A1").CurrentRegion.Offset(1, 0)
.Columns(1).Cells.Copy Destination:=Range("K1000000").End(xlUp).Offset(1, 0)
.Columns(2).Cells.Copy Destination:=Range("J1000000").End(xlUp).Offset(1, 0)
.Columns(3).Cells.Copy Destination:=Range("U1000000").End(xlUp).Offset(1, 0)
End With
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I don't care what you think of me! Unless you think I'm awesome – in which case, you're right! Carry on
-
- Mesaje: 10
- Membru din: Joi Iun 22, 2017 2:56 pm
Re: Buna am nevoie de ajutorul vostru
Am o eroare 400 la copierea conditionata si nu gasesc, va rog daca ma puteti ajuta!
Multumesc anticipat.
Las atasata arhiva.
Multumesc anticipat.
Las atasata arhiva.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: Buna am nevoie de ajutorul vostru
Buna ziua
In primul rand, ati editat defectuos codul meu inlocuind peste tot 1000000 (adica un million) cu, nici nu mai stiu, 10 miliarde. Milionul acela avea legatura cu numarul maxim de randuri dintr-o foaie excel (1048576)
In al doilea rand, ati mutat codul meu dintr-un modul in alta zona, thisworkbook a editorului macro
In al treilea rand, aveti niste formule in foaia sursa care nu ar trebui sa aiba probleme deosebite la copiere in alta foaie din acelasi fisier dar sa dea erori la copierea in alt fisier.
Sunt sanse ca o parte din cod sa trebuiasca rescrisa in concordanta cu situatia reala. E de inteles sa existe formule in foaia-sursa dar celelalte in foile (si mai ales in fisierul) de destinatie mai sunt necesare?
IP
In primul rand, ati editat defectuos codul meu inlocuind peste tot 1000000 (adica un million) cu, nici nu mai stiu, 10 miliarde. Milionul acela avea legatura cu numarul maxim de randuri dintr-o foaie excel (1048576)
In al doilea rand, ati mutat codul meu dintr-un modul in alta zona, thisworkbook a editorului macro
In al treilea rand, aveti niste formule in foaia sursa care nu ar trebui sa aiba probleme deosebite la copiere in alta foaie din acelasi fisier dar sa dea erori la copierea in alt fisier.
Sunt sanse ca o parte din cod sa trebuiasca rescrisa in concordanta cu situatia reala. E de inteles sa existe formule in foaia-sursa dar celelalte in foile (si mai ales in fisierul) de destinatie mai sunt necesare?
IP
-
- Mesaje: 10
- Membru din: Joi Iun 22, 2017 2:56 pm
Re: Buna am nevoie de ajutorul vostru
Nu este nevoie sa copiez cu formule ci doar sa copiez valorile cu plus si cu minus in acel fisier pe coloanele care trebuie atat trebuie sa fac.
Ultima oară modificat Joi Iun 29, 2017 9:19 am de către IPP, modificat 1 dată în total.
Motiv: Stergere citat
Motiv: Stergere citat
Re: Buna am nevoie de ajutorul vostru
Buna ziua
In fisierul atasat am modificat codul, l-am plasat intr-un modul dar poate fi accesat cu ajutorul butonului 2
Noul cod este:
In privinta erorii 400, e una dintre erorile "ciudate" (eu inca nu am avut-o in proiectele personale) care, se pare, nu te duce automat la linia din cod care a provocat crash-ul procedurii. Teoretic trebuie rulat codul linie cu linie pentru a detecta cauza, ceea ce pentru un volum mare de prelucari este obositor de realizat. Am testat codul de mai sus pe bucati mai mari (partea de scriere info in foile cu + si - respectiv partea de scriere info in celalalt fisier si nu am avut eroare. La rularea integrala a codului insa da. Am presupus ca, trebuind sa lucreze cu doua fisiere (lucru pe care eu il evit pe cat posibil), procedura nu stie la un moment dat care e range-ul cu care trebuie sa lucreze si mai ales care e foaia de interes, dat fiind faptul ca exista un "Sheet1" in ambele fisiere (desi, teoretic cred ca am fost destul de clar in cod). In fine, am redenumit Sheet1 din fisierul sursa in Sheet21 si am putut rula macro fara sa mai apara erori.
Nu va ramane decat sa salvati fisierul atasat la dvs. in locatia specifica si sa faceti propriile teste
IP
In fisierul atasat am modificat codul, l-am plasat intr-un modul dar poate fi accesat cu ajutorul butonului 2
Noul cod este:
Cod: Selectaţi tot
Sub CopiereConditionata()
'IPP - 29.06.2017
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim myPath As String
myPath = ThisWorkbook.Path
Dim fDestin As String
fDestin = "Model Fisier Inventar.xlsx"
Dim myRng As Range
Set myRng = Sheets("Stoc mag").Range("A1").CurrentRegion.Offset(1, 0).Columns(5).Cells
For Each c In myRng
If c.Value < 0 Then
c.EntireRow.Copy
With Sheets("Valorile cu -").Range("A1000000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
End If
If c.Value > 0 Then
c.EntireRow.Copy
With Sheets("Valorile cu +").Range("A1000000").End(xlUp).Offset(1, 0)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
End If
Next c
Application.CutCopyMode = False
Workbooks.Open Filename:=myPath & "\" & fDestin
Sheets("Sheet1").Select
With ThisWorkbook.Sheets("Valorile cu +").Range("A1").CurrentRegion.Offset(1, 0)
.Columns(1).Cells.Copy Destination:=Range("K1000000").End(xlUp).Offset(1, 0)
.Columns(2).Cells.Copy Destination:=Range("J1000000").End(xlUp).Offset(1, 0)
.Columns(3).Cells.Copy Destination:=Range("U1000000").End(xlUp).Offset(1, 0)
End With
With ThisWorkbook.Sheets("Valorile cu -").Range("A1").CurrentRegion.Offset(1, 0)
.Columns(1).Cells.Copy Destination:=Range("K1000000").End(xlUp).Offset(1, 0)
.Columns(2).Cells.Copy Destination:=Range("J1000000").End(xlUp).Offset(1, 0)
.Columns(3).Cells.Copy Destination:=Range("U1000000").End(xlUp).Offset(1, 0)
End With
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Nu va ramane decat sa salvati fisierul atasat la dvs. in locatia specifica si sa faceti propriile teste
IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
-
- Mesaje: 10
- Membru din: Joi Iun 22, 2017 2:56 pm
Re: Buna am nevoie de ajutorul vostru
Am testat, deocamdata functioneaza perfect.
Va multumesc frumos.
Imi este de mare folos.
Va multumesc frumos.
Imi este de mare folos.