API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jan 10th, 2019
187
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.60 KB | None | 0 0
raw download clone embed print report
  1.  
  2. Sub řešič_MN_V()
  3. Dim a As Integer, b As Integer, poleVysl() As Double, i As Integer, j As Integer, VYSL As Double, VYSLi(10, 5) As Integer, VYSLj(10, 5) As Integer
  4. Dim poleList(5) As String, ListI As Integer, vyslL(5) As Double, Ri As Integer, vyslR As Integer, rMax, RR As Double, bw As Double
  5. Dim poleListV(3) As String, ListVi As Integer, vyslRi(10) As Double
  6. ThisWorkbook.Save
  7. Application.ScreenUpdating = False
  8. poleList(1) = "Sd-rr_MN"
  9. poleList(2) = "Sd-s_MN"
  10. poleList(3) = "Hd-rr_MN"
  11. poleList(4) = "Hd-s_MN"
  12. poleList(5) = "St-s_MN"
  13. poleListV(1) = "Sd_V"
  14. poleListV(2) = "Hd_V"
  15. poleListV(3) = "St_V"
  16. bw = Sheets("zadání").Cells(54, 2) * 1000
  17. VYSL = 1000
  18. a = Sheets("Zadání").Cells(Rows.Count, "ao").End(xlUp).Row 'ještě by to chtělo dodělat, zatím je to tak, že všechny rastry mají stejný počet řádků
  19. b = a
  20. ReDim poleVysl(a, b)
  21. For Ri = 1 To 5
  22. For ListI = 1 To 5
  23. With Sheets(poleList(ListI)).Select
  24. If Ri = 1 Then
  25. .Cells(18, 4) = 12
  26. End If
  27. ListVi = WorksheetFunction.RoundUp(ListI / 2, 0)
  28. vyslL(ListI) = 1000
  29. For j = 1 To b
  30. For i = 1 To a
  31. If vyslL(ListI) > Sheets("zadání").Cells(i, 46 + (Ri - 1) * 7) + Sheets("zadání").Cells(j, 46 + (Ri - 1) * 7) Then
  32. If Sheets("zadání").Cells(i, 46 + (Ri - 1) * 7) > .Cells(51, 8) Then
  33. If Sheets("zadání").Cells(j, 46 + (Ri - 1) * 7) > .Cells(51, 8) Then
  34. .Cells(18, 4) = Sheets("Zadání").Cells(i, 44 + (Ri - 1) * 7)
  35. .Cells(18, 5) = Sheets("Zadání").Cells(i, 45 + (Ri - 1) * 7)
  36. .Cells(19, 4) = Sheets("Zadání").Cells(j, 44 + (Ri - 1) * 7)
  37. .Cells(19, 5) = Sheets("Zadání").Cells(j, 45 + (Ri - 1) * 7)
  38. .Cells(22, 12) = 0.02
  39. .Cells(43, 12) = 0.02
  40. .Range("L23").GoalSeek Goal:=0, ChangingCell:=Range("L22")
  41. .Range("L44").GoalSeek Goal:=0, ChangingCell:=Range("L43")
  42. If .Cells(53, 6) = "OK!" Then
  43. If .Cells(54, 6) = "OK!" Then
  44. If Abs(.Cells(24, 10)) > 1 Then
  45. If Abs(.Cells(45, 10)) > 1 Then
  46. .Cells(62, 4) = .Cells(18, 4) * 0.001
  47. .Cells(66, 7) = .Cells(18, 5)
  48. .Cells(69, 11) = .Cells(19, 4) * 0.001
  49. .Cells(70, 11) = .Cells(19, 5)
  50. .Cells(110, 4) = .Cells(39, 4) * 0.001
  51. .Cells(114, 7) = .Cells(39, 5)
  52. .Cells(117, 11) = .Cells(40, 4) * 0.001
  53. .Cells(118, 11) = .Cells(40, 5)
  54. If .Cells(102, 11) > 1 Then
  55. If .Cells(150, 11) > 1 Then
  56. rMax = 0.75 * .Cells(18, 7)
  57. If .Cells(18, 4) - WorksheetFunction.RoundDown(.Cells(18, 4), 0) > 0 Then
  58. RR = bw / (.Cells(18, 5)) '* 2)
  59. Else: RR = bw / .Cells(18, 5)
  60. End If
  61. If Sheets(poleListV(ListVi)).Cells(22, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(23, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(44, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(45, 13) = "Vyhovuje" Then
  62. poleVysl(i, j) = .Cells(18, 6) * 0.000001 + .Cells(19, 6) * 0.000001
  63. Else:
  64. If rMax > RR Then
  65. poleVysl(i, j) = .Cells(18, 6) * 0.000001 + .Cells(19, 6) * 0.000001
  66. Else: poleVysl(i, j) = 1000
  67. End If
  68. End If
  69. Else: poleVysl(i, j) = 1000
  70. End If
  71. Else: poleVysl(i, j) = 1000
  72. End If
  73. Else: poleVysl(i, j) = 1000
  74. End If
  75. Else: poleVysl(i, j) = 1000
  76. End If
  77. Else: poleVysl(i, j) = 1000
  78. End If
  79. Else: poleVysl(i, j) = 1000
  80. End If
  81. If poleVysl(i, j) < vyslL(ListI) Then
  82. vyslL(ListI) = poleVysl(i, j)
  83. VYSLi(Ri, ListI) = i
  84. VYSLj(Ri, ListI) = j
  85. End If
  86. Else: poleVysl(i, j) = 1000
  87. End If
  88. Else: poleVysl(i, j) = 1000
  89. End If
  90. End If
  91. Next
  92. Next
  93. vyslRi(Ri) = vyslRi(Ri) + vyslL(ListI)
  94. jds = jds + 1
  95. ProcentHotovo = WorksheetFunction.RoundDown((jds / 29) * 100, 0)
  96. Application.StatusBar = "Hotovo: " & ProcentHotovo & "%"
  97. Application.Wait Now + TimeValue("00:00:01") 'zpoždění 1 sec
  98. End With
  99. Next
  100. If vyslRi(Ri) < VYSL Then
  101. VYSL = vyslRi(Ri)
  102. vyslR = Ri
  103. End If
  104. Next
  105. Ri = vyslR
  106. Sheets("Sd-rr_MN").Cells(1, 1) = Ri
  107. For ListI = 1 To 5
  108. With Sheets(poleList(ListI))
  109. .Select
  110. .Cells(18, 4) = Sheets("Zadání").Cells(VYSLi(Ri, ListI), 44 + (Ri - 1) * 7)
  111. .Cells(18, 5) = Sheets("Zadání").Cells(VYSLi(Ri, ListI), 45 + (Ri - 1) * 7)
  112. .Cells(19, 4) = Sheets("Zadání").Cells(VYSLj(Ri, ListI), 44 + (Ri - 1) * 7)
  113. .Cells(19, 5) = Sheets("Zadání").Cells(VYSLj(Ri, ListI), 45 + (Ri - 1) * 7)
  114. .Range("L23").GoalSeek Goal:=0, ChangingCell:=Range("L22")
  115. .Range("L44").GoalSeek Goal:=0, ChangingCell:=Range("L43")
  116. .Cells(26, 12) = Sheets("Zadání").Cells(VYSLi(Ri, ListI), 47 + (Ri - 1) * 7)
  117. .Cells(27, 12) = Sheets("Zadání").Cells(VYSLj(Ri, ListI), 47 + (Ri - 1) * 7)
  118. If VYSLi(Ri, ListI) <> 1 Then
  119. .Cells(26, 16) = Sheets("Zadání").Cells(VYSLi(Ri, ListI) - 1, 47 + (Ri - 1) * 7 - 1)
  120. Else: .Cells(26, 16) = Sheets("Zadání").Cells(VYSLi(Ri, ListI), 47 + (Ri - 1) * 7 - 1)
  121. End If
  122. If VYSLj(Ri, ListI) <> 1 Then
  123. .Cells(27, 16) = Sheets("Zadání").Cells(VYSLj(Ri, ListI) - 1, 47 + (Ri - 1) * 7 - 1)
  124. Else: .Cells(27, 16) = Sheets("Zadání").Cells(VYSLj(Ri, ListI), 47 + (Ri - 1) * 7 - 1)
  125. End If
  126. .Cells(62, 4) = .Cells(18, 4) * 0.001
  127. .Cells(66, 7) = .Cells(18, 5)
  128. .Cells(69, 11) = .Cells(19, 4) * 0.001
  129. .Cells(70, 11) = .Cells(19, 5)
  130. .Cells(110, 4) = .Cells(39, 4) * 0.001
  131. .Cells(114, 7) = .Cells(39, 5)
  132. .Cells(117, 11) = .Cells(40, 4) * 0.001
  133. .Cells(118, 11) = .Cells(40, 5)
  134. .Cells(161, 4) = .Cells(18, 4)
  135. .Cells(162, 4) = .Cells(18, 5)
  136. .Cells(163, 4) = .Cells(19, 4)
  137. .Cells(164, 4) = .Cells(19, 5)
  138. .Cells(194, 4) = .Cells(39, 4)
  139. .Cells(195, 4) = .Cells(39, 5)
  140. .Cells(196, 4) = .Cells(40, 4)
  141. .Cells(197, 4) = .Cells(40, 5)
  142. ProcentHotovo = WorksheetFunction.RoundDown((26 / 29) * 100, 0)
  143. Application.StatusBar = "Hotovo: " & ProcentHotovo & "%"
  144. Application.Wait Now + TimeValue("00:00:01") 'zpoždění 1 sec
  145. End With
  146. Next
  147. Dim rastr As Double, stMAX As Double, sMAX As Double, nt As Integer, k As Integer, ASW As Double, maxmin As Integer, ASWmin As Double
  148. Dim ASWminI As Integer, ASWminJ As Integer, ASWminK As Integer, RastrMax As Double
  149. For ListVi = 1 To 3
  150. If Sheets(poleListV(ListVi)).Cells(22, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(23, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(44, 13) = "Vyhovuje" And Sheets(poleListV(ListVi)).Cells(45, 13) = "Vyhovuje" Then
  151. Else:
  152. ASW = 1000
  153. bw = Sheets(poleListV(ListVi)).Cells(55, 4) * 1000
  154. If Sheets("Sd-rr_MN").Cells(18, 4) - WorksheetFunction.RoundDown(Sheets("Sd-rr_MN").Cells(18, 4), 0) > 0 Then
  155. rastr = Sheets("Sd-rr_MN").Cells(18, 5) ' * 2
  156. Else: rastr = Sheets("Sd-rr_MN").Cells(18, 5)
  157. End If
  158. stMAX = Application.Min(Sheets(poleListV(ListVi)).Cells(57, 12), 600)
  159. sMAX = Application.Min(Sheets(poleListV(ListVi)).Cells(57, 12), 400)
  160. nt = WorksheetFunction.RoundDown(stMAX / (bw / rastr), 0)
  161. For maxmin = 0 To 1
  162. ASWmin = 1000
  163. For i = 1 To nt
  164. Sheets(poleListV(ListVi)).Cells(54 + maxmin * 13, 9) = rastr / i
  165. RastrMax = WorksheetFunction.RoundDown((sMAX / 25), 0) * 25
  166. For j = RastrMax To 75 Step -25
  167. Sheets(poleListV(ListVi)).Cells(56 + maxmin * 13, 9) = j * 0.001
  168. For k = 1 To 13
  169. Sheets(poleListV(ListVi)).Cells(53 + maxmin * 13, 9) = Sheets("zadání").Cells(k, 41)
  170. If Sheets(poleListV(ListVi)).Cells(59 + maxmin * 13, 14) = "vyhovie" And Sheets(poleListV(ListVi)).Cells(61 + maxmin * 13, 14) = "vyhovie" Then
  171. ASW = Sheets(poleListV(ListVi)).Cells(55 + maxmin * 13, 9) * (rastr / i)
  172. Exit For
  173. End If
  174. Next
  175. If ASWmin > ASW Then
  176. ASWmin = ASW
  177. ASWminI = i
  178. ASWminJ = j
  179. ASWminK = k
  180. End If
  181. Next
  182. Next
  183. Sheets(poleListV(ListVi)).Cells(54 + maxmin * 13, 9) = rastr / ASWminI
  184. Sheets(poleListV(ListVi)).Cells(56 + maxmin * 13, 9) = ASWminJ * 0.001
  185. Sheets(poleListV(ListVi)).Cells(53 + maxmin * 13, 9) = Sheets("zadání").Cells(ASWminK, 41)
  186. Next
  187. End If
  188. jds = jds + 1
  189. ProcentHotovo = WorksheetFunction.RoundDown((jds / 29) * 100, 0)
  190. Application.StatusBar = "Hotovo: " & ProcentHotovo & "%"
  191. Application.Wait Now + TimeValue("00:00:01") 'zpoždění 1 sec
  192. Next
  193. Sheets("výsledky").Select
  194. Application.ScreenUpdating = True
  195. Application.StatusBar = False
  196. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!