cautare rezultat repetat cu salvare valori gasite
cautare rezultat repetat cu salvare valori gasite
In fisierul atasat, fac manual urmatoarele operatii (un fel de Cautare rezultat din Excel, repetat):
-modific valoarea din coloana B (folosind bara de defilare din coloana A) pana cand Calcul1=Referinta1. Salvez valoarea din coloana B in coloana I.
-modific in continuarea valoarea din coloana B pana cand Calcul2=Referinta2. Salvez valoarea din coloana B in coloana J.
-repet cele de mai sus pentru urmatorul rand.
Ma intereseaza sa automatizez acest lucru cu un cod VBA (tabelul va avea mai multe inregistrari, de ordinul zecilor, poate sute).
Multumesc anticipat pentru orice idee.
-modific valoarea din coloana B (folosind bara de defilare din coloana A) pana cand Calcul1=Referinta1. Salvez valoarea din coloana B in coloana I.
-modific in continuarea valoarea din coloana B pana cand Calcul2=Referinta2. Salvez valoarea din coloana B in coloana J.
-repet cele de mai sus pentru urmatorul rand.
Ma intereseaza sa automatizez acest lucru cu un cod VBA (tabelul va avea mai multe inregistrari, de ordinul zecilor, poate sute).
Multumesc anticipat pentru orice idee.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Am incropit un cod, cred ca mai trebuie optimizat ca sa nu dureze prea mult rularea lui pe un tabel mai mare.
Cod: Selectaţi tot
Sub calculeaza()
'Dim Rng As Range
Dim rnd As Integer
Dim i As Integer
Dim j As Integer
'Dim RowCount As Integer
'Set Rng = Selection
'RowCount = Rng.Rows.Count
For rnd = 11 To 13
Range("I" & rnd).Value = rnd
i = 19000
Do Until Range("G" & rnd) = Range("D" & rnd)
Range("I" & rnd).Value = Range("C" & rnd).Value + 1
i = i + 1
Range("B" & rnd) = i
Loop
j = 19000
Do Until Range("H" & rnd) = Range("E" & rnd)
Range("J" & rnd).Value = Range("C" & rnd).Value + 1
j = j + 1
Range("B" & rnd) = j
Loop
Next rnd
End Sub
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Buna ziua
Pana la o solutie cu macro (sau mixta), ati incercat sa vedeti daca nu se obtine rezultatul asteptat mai usor folosind instrumentul Excel Goal Seek?
In poza atasata veti vedea un exemplu de mod de aplicare, respectiv de rezultat. Acolo acel rezultat este cu zecimale. Nu stiu in ce masura acest lucru e convenabil sau ideea in sine ar fi in regula pentru dvs.
IP
Pana la o solutie cu macro (sau mixta), ati incercat sa vedeti daca nu se obtine rezultatul asteptat mai usor folosind instrumentul Excel Goal Seek?
In poza atasata veti vedea un exemplu de mod de aplicare, respectiv de rezultat. Acolo acel rezultat este cu zecimale. Nu stiu in ce masura acest lucru e convenabil sau ideea in sine ar fi in regula pentru dvs.
IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Buna ziua
Atasat aveti spre testare o propunere folosind macro si Goal Seek
Obiectiv: gasirea si salvarea unor valori pe baza unei formule preexistente si a unor valori de referinta
Premise: se respecta structura actuala a informatiei, fara randuri goale sau inserari de coloane intermediare.
inainte de rularea macro va asigurati ca toata informatia necesara (inclusiv formulele de pe coloanele G si H) sunt completate (Goal Seek lucreaza exclusiv daca exista formula unde trebuie)
Alte precizari: am lucrat extrem de putin (mai mult de curiozitate, cu instrumentul Goal Seek) deci nu sunt in masura sa spun despre alte potentiale probleme ce pot sa apara. Asadar, testati.
Cum spuneam in mesajul anterior, cel mai probabil vor fi rezultate cu zecimale. In functie de ce se doreste, la o adica, acele rezultate pot fi salvate rotunjite (in exemplul meu sunt asa cum le-a gasit Excel).
De asemenea ar trebui sa vedeti totusi care este rezultatul asteptat. De exemplu, in fisierul meu Goal Seek a gasit pentru primul caz (B11 in legatura cu formula din G11), daca a pornit de la 0, valoarea 29462,0488 insa daca folosim sistemul dvs. "manual" rezultatul bun pare a fi orice valoare situata intre 29437 si 29473. Pentru o valoare de start mai mare de 29463 Goal Seek ar fi gasit alt rezultat (ex. 29470)
Am folosit urmatorul cod:
Pentru testare: deschideti fisierul atasat, activati macro/continutul si rulati macro (am lasat inclusiv in foaie un "buton")
IP
Atasat aveti spre testare o propunere folosind macro si Goal Seek
Obiectiv: gasirea si salvarea unor valori pe baza unei formule preexistente si a unor valori de referinta
Premise: se respecta structura actuala a informatiei, fara randuri goale sau inserari de coloane intermediare.
inainte de rularea macro va asigurati ca toata informatia necesara (inclusiv formulele de pe coloanele G si H) sunt completate (Goal Seek lucreaza exclusiv daca exista formula unde trebuie)
Alte precizari: am lucrat extrem de putin (mai mult de curiozitate, cu instrumentul Goal Seek) deci nu sunt in masura sa spun despre alte potentiale probleme ce pot sa apara. Asadar, testati.
Cum spuneam in mesajul anterior, cel mai probabil vor fi rezultate cu zecimale. In functie de ce se doreste, la o adica, acele rezultate pot fi salvate rotunjite (in exemplul meu sunt asa cum le-a gasit Excel).
De asemenea ar trebui sa vedeti totusi care este rezultatul asteptat. De exemplu, in fisierul meu Goal Seek a gasit pentru primul caz (B11 in legatura cu formula din G11), daca a pornit de la 0, valoarea 29462,0488 insa daca folosim sistemul dvs. "manual" rezultatul bun pare a fi orice valoare situata intre 29437 si 29473. Pentru o valoare de start mai mare de 29463 Goal Seek ar fi gasit alt rezultat (ex. 29470)
Am folosit urmatorul cod:
Cod: Selectaţi tot
Sub CalculGoalSeek()
'IPP - 06.12.2019
Dim myRef As Integer
Dim myChCell As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("G11").Select
Do Until IsEmpty(ActiveCell)
myRef = ActiveCell.Offset(0, -3).Value
Set myChCell = ActiveCell.Offset(0, -5)
ActiveCell.GoalSeek Goal:=myRef, ChangingCell:=myChCell
ActiveCell.Offset(0, 2).Value = myChCell.Value
ActiveCell.Offset(1, 0).Select
Loop
Range("H11").Select
Do Until IsEmpty(ActiveCell)
myRef = ActiveCell.Offset(0, -3).Value
Set myChCell = ActiveCell.Offset(0, -6)
ActiveCell.GoalSeek Goal:=myRef, ChangingCell:=myChCell
ActiveCell.Offset(0, 2).Value = myChCell.Value
ActiveCell.Offset(1, 0).Select
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Multumesc pentru solutie, o sa analizez sa vad cum fac cu rotunjirile pentru ca ma intereseaza cea mai mica valoare la care se indeplinesc condiile.
Re: cautare rezultat repetat cu salvare valori gasite
Buna ziua
Atasat aveti spre testare o propunere folosind macro.
Chiar daca trebuie respectate toate premisele din propunerea anterioara, in fisierul atasat veti gasi o varianta in care calcularea se bazeaza exclusiv pe informatia din coloanele cu Referinta1, Referinta2 si Constanta, restul fiind hardcodat.
Cel putin pana la proba contrarie, se va scrie prima valoare care intruneste conditia.
Am folosit urmatorul cod:
Pentru testare: deschideti fisierul atasat, activati macro/continutul si rulati codul (se poate si de la butonul lasat de mine in foaie)
IP
Atasat aveti spre testare o propunere folosind macro.
Chiar daca trebuie respectate toate premisele din propunerea anterioara, in fisierul atasat veti gasi o varianta in care calcularea se bazeaza exclusiv pe informatia din coloanele cu Referinta1, Referinta2 si Constanta, restul fiind hardcodat.
Cel putin pana la proba contrarie, se va scrie prima valoare care intruneste conditia.
Am folosit urmatorul cod:
Cod: Selectaţi tot
Sub Calcul()
'IPP - 07.12.2019
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim valRef1 As Integer
Dim valRef2 As Integer
Dim const1 As Integer
Dim deModificat As Long
Dim myData As Long
Dim result As Double
Range("G11").Select
Do Until IsEmpty(ActiveCell)
const1 = ActiveCell.Offset(0, -1).Value
valRef1 = ActiveCell.Offset(0, -3).Value
valRef2 = ActiveCell.Offset(0, -2).Value
deModificat = 0
myData = deModificat + 18000
For i = 1 To 50000
result = Round(const1 + (myData - Date) / 365, 1)
If result = valRef1 Then
ActiveCell.Offset(0, 2).Value = deModificat
Exit For
End If
deModificat = deModificat + 1
myData = myData + 1
Next i
deModificat = 0
myData = deModificat + 18000
For i = 1 To 50000
result = Round(65 - (myData - Date) / 365, 0)
If result = valRef2 Then
ActiveCell.Offset(0, 3).Value = deModificat
Exit For
End If
deModificat = deModificat + 1
myData = myData + 1
Next i
ActiveCell.Offset(1, 0).Select
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
IP
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Multumesc, e o varianta mult mai rapida. Din fiecare varinata propusa am retinut cate ceva, o sa vad ce aplic in tabelul meu real, care e mai complicat (mai multe coloane, formule mai complicate). Dupa, o sa revin cu tabelul real.
Re: cautare rezultat repetat cu salvare valori gasite
Atasez fisierul cu tabelul real (util pentru calculul datelor calendaristice cand se indeplinesc conditiile de pensie - indeplinire stagiu de cotizare si atingere data redusa de pensionare, tinand cont si de vechimea in grupele I si II, conditii speciale si conditii deosebite).
Rularea macrocomenzii pe intregul tabel dureaza cam mult (la mine vreo 1,5 ore pt cca. 480 de inregistrari), orice imbunatatire/corectie a codului e bine primita!
Rularea macrocomenzii pe intregul tabel dureaza cam mult (la mine vreo 1,5 ore pt cca. 480 de inregistrari), orice imbunatatire/corectie a codului e bine primita!
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Re: cautare rezultat repetat cu salvare valori gasite
Buna
1. Opreste updatare ecran
insereaza chiar la inceput in Sub calculeaza()
Application.ScreenUpdating = False
si la sfarsit
Application.ScreenUpdating = True
Pe incercate in acest mod 10 randuri au fost calculate sub 20 sec.
2 Inceraca sa schimbi conceptia programului.
Un tabel numai datele de intrare, toate calculele cu VBA, fara formule.
Uneori reduce si aceasta timpul de calcul.
1. Opreste updatare ecran
insereaza chiar la inceput in Sub calculeaza()
Application.ScreenUpdating = False
si la sfarsit
Application.ScreenUpdating = True
Pe incercate in acest mod 10 randuri au fost calculate sub 20 sec.
2 Inceraca sa schimbi conceptia programului.
Un tabel numai datele de intrare, toate calculele cu VBA, fara formule.
Uneori reduce si aceasta timpul de calcul.
Re: cautare rezultat repetat cu salvare valori gasite
Mulțumesc!
Punctul 1 l-am aplicat, dar la 2 e prea complicat pentru mine să scriu toate formulele în VBA (nu cunosc echivalența funcțiilor excel-vba).
Punctul 1 l-am aplicat, dar la 2 e prea complicat pentru mine să scriu toate formulele în VBA (nu cunosc echivalența funcțiilor excel-vba).