Új hozzászólás Aktív témák

• #45398 Fferi50 Topikgazda KBaj #45397

  Új Válasz 2020-11-20 21:36:03 #45398

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  válasz KBaj #45397 üzenetére

  Szia!
  Mutatom a </> gombot:
  
  És az eredménye:
  Function Poisson2(Feltétel2 As Range) As Long
Call kep_ki
Application.Volatile ’Prohardver Delila_1 nyomán
k = 0
Kezd = Cells(8, 7) 'Feltétel kezdete oszlop
Kezd5 = Kezd + 5 'Javasolt számok terület előtti oszlop száma
Kezd22 = Kezd + 22 'Feltételek a javaslat válogatásához
a = Cells(12, Kezd) 'A munkatábla kezdő előtti oszlop száma
Előford = Kezd + a 'K(i) táblázat kezdő előtti oszlop száma
Valószín = Előford + 90 'P(x=1) táblázat kezdő előtti oszlop száma
Várak = Valószín + 90 'n(i) táblázat kezdő előtti oszlop száma
Us = Cells(4, 7) + Cells(2, 7) 'Táblázat utolsó sora
Cikl = Cells(5, Előford + 1) 'A számolás kezdete sor
Cells(6, Előford + 1) = Cikl 'Ez lesz a Ciklusváltozó kezdete
Range(Cells(Cikl + 1, Kezd + 1), Cells(Us, Kezd + 15)).ClearContents 'számítása sorok törlése
Range(Cells(Cikl, Előford + 1), Cells(Us, Valószín)).ClearContents 'K(i) táblázat törlése
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'Feltételek
Range("AF11:AJ11").Value = Range("AF4:AJ4").Value 'Manuális számítás
'Calculate 'A munkalapfüggvények számolása
For Cikl = Cells(6, Előford + 1) To Us 'Az utolsó + 1-ig
'1. : 'Az n(i-1) és az előző ciklusban kitörölt képletek újrafelépítése a Tartalék raktárcellából BF14
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula 'Képlet
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'[P(x=1) 13-dik sor]
For i = 1 To 5
For j = 1 To 90
Calculate 'A munkalapfüggvények kiszámolják a 14-dik
If Cells(13, Előford + j) <= Cells(11, Kezd22 + i) _
And Cells(14, Előford + j) Then
For k = 1 To 5
If Cells(14, Előford + j) = Cells(Cikl, Kezd5 + k) Then GoTo Köv
Next k
Cells(Cikl, Kezd5 + Cells(17, Kezd5 + i)) = Cells(14, Előford + j)
Cells(Cikl, Kezd + 10 + Cells(17, Kezd5 + i)) = Cells(13, Előford + j)
Cells(14, Előford + j) = ""
j = 90
End If
Köv: Next j
Next i
'2.
Cells(6, Előford + 1) = Cikl
'Calculate 'A munkalapfüggvények számolása
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Kezd + j) = Cells(12, Előford + Cells(Cikl, 3 + j))
Next j
Else
End If
'Calculate 'A munkalapfüggvények számolása
Range(Cells(Cikl, Előford + 1), Cells(Cikl, Valószín)).Value _
= Range(Cells(Cikl - 1, Előford + 1), Cells(Cikl - 1, Valószín)).Value
For j = 1 To 90
Cells(8, Előford + j) = Cells(8, Előford + j) + 1 'n(i) cellasor munkatáblában(i) cellasor
Next j
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Előford + Cells(Cikl, 3 + j)) _
= Cells(Cikl, Előford + Cells(Cikl, 3 + j)) + 1
Cells(8, Előford + Cells(Cikl, 3 + j)) = 0 'n(i) cellasor
Next j
End If
'Calculate
Range(Cells(Cikl, Valószín + 1), Cells(Cikl, Várak)).Value _
= Range(Cells(12, Előford + 1), Cells(12, Valószín)).Value
Range(Cells(Cikl, Várak + 1), Cells(Cikl, Várak + 90)).Value _
= Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value
Next Cikl
Call CountCcolor 'Prohardver nyomám Színes cellák számolása**** Modul3 lapon
Poisson2 = WorksheetFunction.Sum(Range("O14:S14")) 'Solver Célcella
Call kep_be
End Function
  Amint látod, sokkal olvashatóbb.
  Érdekes lenne még az a munkalap, amin futtatod ezt a makrót. Legalább egy kép a használt területről.
  Üdv.

Új hozzászólás Aktív témák