SHARE
TWEET

VBA 2

maciejms Apr 19th, 2019 (edited) 126 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2. Sub petla1()
  3. ' wpisuje do komórek A1:A9 kolejne liczby począwszy od 10
  4.    Dim i As Integer, a As Integer
  5.     a = 10
  6.     For i = 1 To 9
  7.     Cells(i, 1) = a
  8.     a = a + 1 ' a++
  9.    Next i
  10. End Sub
  11. Sub petla2()
  12. 'sprawdza ile razy liczba x wystąpiła w zakresie A1:A5
  13.    Dim s As Integer, i As Integer, x As Integer, a As Integer
  14.     x = InputBox("Podaj dowolną liczbę całkowitą")
  15.     s = 0
  16.     For i = 1 To 5
  17.         a = Cells(i, 1)
  18.             If (x = a) Then
  19.                 s = s + 1
  20.             End If
  21.     Next i
  22.     MsgBox "Ilość wystąpień liczby " & x & Chr(13) & s
  23.     End Sub
  24. Sub petla3()
  25. 'wyszukiwanie najmniejszej/największej liczby w zakresie A1:A9
  26.    Dim i As Integer, max As Integer, min As Integer, a As Integer
  27.     max = Cells(1, 1)
  28.     min = Cells(1, 1)
  29.     For i = 1 To 9
  30.         a = Cells(i, 1)
  31.         If (a < min) Then
  32.             min = a
  33.         End If
  34.         If (a > max) Then
  35.             max = a
  36.         End If
  37.     Next i
  38.     MsgBox "Wartośc najmniejsza: " & min & Chr(13) & "Wartość najwięsza: " & max
  39. End Sub
  40. Sub petla4()
  41. ' skoki
  42.    Dim i As Integer, dist As Single, distNote, styleNote As Single, min As Integer, max As Integer
  43.     dist = Cells(1, 2)
  44.     min = Cells(1, 1)
  45.     max = Cells(1, 1)
  46.     styleNote = 0
  47.     For i = 1 To 5
  48.         styleNote = styleNote + Cells(i, 1)
  49.         If Cells(i, 1) < min Then
  50.             min = Cells(i, 1)
  51.         End If
  52.         If Cells(i, 1) > max Then
  53.             max = Cells(i, 1)
  54.         End If
  55.     Next i
  56.     styleNote = styleNote - (min + max)
  57.     distNote = 60 + (dist - 120) * 1.8
  58.     MsgBox "Punty za styl: " & styleNote & Chr(13) & "Punkty za odległość: " & distNote & Chr(13) & "Suma: " & styleNote + distNote
  59. End Sub
  60. Sub petla5()
  61. ' zmienia miejscami liczby w arkuszu a1->a2->...->a10
  62.    Dim i As Integer, pom As Single
  63.     pom = Cells(10, 1)
  64.     For i = 9 To 1 Step -1
  65.         Cells(i + 1, 1) = Cells(i, 1)
  66.     Next i
  67.     Cells(1, 1) = pom
  68. End Sub
  69. Sub petla6()
  70. 'silna n
  71.     Dim n As Integer, i As Integer, s As Integer
  72.     n = InputBox("Podaj n")
  73.     s = 1
  74.     For i = 1 To n
  75.         s = s * i
  76.     Next i
  77.     MsgBox s
  78. End Sub
  79. Sub petla7()
  80.     Dim n As Integer, s As Single, i As Integer, l As Integer, m As Integer, a As Single
  81.     l = 1
  82.     m = 1
  83.     n = InputBox("Podaj n")
  84.     For i = 1 To n
  85.         a = l / m
  86.         m = m * 2
  87.         s = s + a
  88.     Next i
  89.     MsgBox s
  90. End Sub
  91. Sub petla8()
  92.     Dim n As Integer, s As Single, l As Single, m As Single, i As Integer, a As Single
  93.     l = 1
  94.     m = 1
  95.     s = 0
  96.     n = CInt(InputBox("Podaj n")) ' Cint konwertuje na typ Integer
  97.    For i = 1 To n
  98.         Cells(i, 4) = l
  99.         Cells(i, 5) = m
  100.         a = l / m
  101.         l = -l
  102.         m = 2 * i + 1
  103.         s = s + a
  104.         Cells(i, 6) = s * 4
  105.     Next i
  106.     MsgBox s * 4
  107. End Sub
  108. Sub petla9()
  109.     Dim n As Integer, i As Integer, b As Boolean
  110.     n = CInt(InputBox("Podaj liczbę"))
  111.     b = True
  112.     For i = 2 To Sqr(n)
  113.         If n Mod i = 0 Then
  114.             b = False
  115.         End If
  116.     Next i
  117.     If b = True Then
  118.         MsgBox "liczba " & n & " pierwsza"
  119.     Else
  120.         MsgBox "liczba " & n & " nie jest pierwsza"
  121.     End If
  122. End Sub
  123. Sub petla10()
  124. ' zamiana liczby 8-bitowej binarnej na dziesiętną, kolejne cyfry liczby binarnej znajdują się w komórkach A1:A8
  125.    Dim i As Integer, dec As Integer
  126.     dec = 0
  127.     For i = 1 To 8
  128.         dec = dec + Cells(i, 1) * 2 ^ (8 - i)
  129.     Next i
  130.     MsgBox dec
  131. End Sub
  132. Sub petla11a()
  133. ' sprawdzanie poprawności numeru PESEL, kolejne cyfry numeru PESEL w komórkach A1:A11
  134.    Dim i As Integer, k As Integer, sum As Integer
  135.     Dim wagi() As Variant
  136.     wagi = Array(9, 7, 3, 1, 9, 7, 3, 1, 9, 7)
  137.     sum = 0
  138.     For i = 1 To 10
  139.         sum = sum + Cells(i, 1) * wagi(i - 1)
  140.     Next i
  141.     'k = sum Mod 10 ' k - cyfra kontrolna
  142.    If sum Mod 10 = Cells(11, 1) Then
  143.         MsgBox "PESEL poprawny"
  144.     Else
  145.         MsgBox "PESEL niepoprawny"
  146.     End If
  147. End Sub
  148. Sub petla11b()
  149.     Dim i As Integer, sum As Integer, wagi() As Variant
  150.     wagi = Array(1, 3, 7, 9, 1, 3, 7, 9, 1, 3, 1)
  151.     sum = 0
  152.     For i = 1 To 11
  153.         sum = sum + wagi(i - 1) * Cells(i, 1)
  154.     Next i
  155.     If sum Mod 10 = 0 Then
  156.         MsgBox "PESEL poprawny"
  157.     Else
  158.         MsgBox "PESEL nie jest poprawny"
  159.     End If
  160. End Sub
  161.  
  162. ' zadanie 12a
  163. ' a = 2
  164. ' b = 16
  165. ' c = 7
  166.  
  167. ' zadanie 12b
  168. ' a = 5
  169. ' b = 8
  170. ' c = 8
RAW Paste Data
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
 
Top