cautare rezultat repetat cu salvare valori gasite

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Joi Dec 05, 2019 5:22 pm

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.
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Joi Dec 05, 2019 8:39 pm

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.

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

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de IPP » Vin Dec 06, 2019 7:57 am

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
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: cautare rezultat repetat cu salvare valori gasite

Mesaj de IPP » Vin Dec 06, 2019 9:36 am

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:

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
Pentru testare: deschideti fisierul atasat, activati macro/continutul si rulati macro (am lasat inclusiv in foaie un "buton")

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

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Sâm Dec 07, 2019 7:19 am

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.

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

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de IPP » Sâm Dec 07, 2019 10:34 am

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:

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
Pentru testare: deschideti fisierul atasat, activati macro/continutul si rulati codul (se poate si de la butonul lasat de mine in foaie)

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

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Sâm Dec 07, 2019 4:46 pm

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.

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Mie Dec 18, 2019 8:18 am

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!
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

csaba1960
Moderator
Moderator
Mesaje: 187
Membru din: Mie Feb 02, 2011 4:05 pm
Localitate: Cluj-Napoca

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de csaba1960 » Vin Dec 20, 2019 9:15 am

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.

dip
Mesaje: 201
Membru din: Sâm Feb 06, 2010 11:09 pm
Localitate: Brasov

Re: cautare rezultat repetat cu salvare valori gasite

Mesaj de dip » Lun Dec 23, 2019 3:29 pm

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).

Scrie răspuns

Înapoi la “Visual Basic for Application (VBA) cu Excel - Intrebari tehnice”