среда, 18 января 2012 г.

Скатерть Улама

Скатерть Улама представляет из себя спираль чисел натурального ряда, на которой отмечены клетки, соответствующие простым числам.

Попробуем составить скатерь Улама в Excel. При этом воспользуемся VBA.

Располагая числа по спирали


обозначим перемещения таким образом:
  • П - вправо
  • В - вверх
  • Л - влево
  • Н - вниз

Тогда при заполнении получаем такой ряд: П В Л Л Н Н П П П В В В Л Л Л Л Н Н Н Н П П П П П ...

Заметим, что следующее идентичное перемещение на 2 шага длиннее предыдущего (к примеру, вправо: сначала 1 раз, потом 3 раза, потом 5 и т.д.).

Это замечание и ляжет в основу алгоритма VBA.

  1. Public Sub Ulam()
  2. Dim i As Integer, tekR As Integer, tekC As Integer
  3. Dim limit As Integer, tekNum As Long
  4. Dim rCell As Range, iColor As Integer
  5. Cells.Clear
  6. Cells.ColumnWidth = 5.83
  7. Cells.RowHeight = 30
  8. tekR = 10
  9. tekC = 10
  10. limit = 1
  11. tekNum = 1
  12. Cells(tekR, tekC) = tekNum
  13. Do While limit < 20
  14. For i = 1 To limit
  15. tekC = tekC + 1
  16. tekNum = tekNum + 1
  17. If tekC = 0 Or tekR = 0 Then Exit Do
  18. Cells(tekR, tekC) = tekNum
  19. Next i
  20. For i = 1 To limit
  21. tekR = tekR - 1
  22. tekNum = tekNum + 1
  23. If tekC = 0 Or tekR = 0 Then Exit Do
  24. Cells(tekR, tekC) = tekNum
  25. Next i
  26. For i = 1 To limit + 1
  27. tekC = tekC - 1
  28. tekNum = tekNum + 1
  29. If tekC = 0 Or tekR = 0 Then Exit Do
  30. Cells(tekR, tekC) = tekNum
  31. Next i
  32. For i = 1 To limit + 1
  33. tekR = tekR + 1
  34. tekNum = tekNum + 1
  35. If tekC = 0 Or tekR = 0 Then Exit Do
  36. Cells(tekR, tekC) = tekNum
  37. Next i
  38. limit = limit + 2
  39. Loop
  40. For Each rCell In ActiveSheet.UsedRange
  41. tekNum = rCell.Value
  42. limit = Int(Sqr(rCell.Value))
  43. iColor = 8
  44. For i = 2 To limit
  45. If tekNum Mod i = 0 Then iColor = 0
  46. Next i
  47. rCell.Interior.ColorIndex = iColor
  48. If tekNum = 1 Then rCell.Interior.ColorIndex = 3
  49. Next
  50. ActiveSheet.UsedRange.Select
  51. ActiveWindow.Zoom = True
  52. Range("A1").Select
  53. End Sub

Немного пояснений по коду:

строки 2 - 3: i - счетчик цикла, tekR - номер строки и tekC - номер столбца ячейки (клетки) с которой работаем, limit - число шагов, tekNum - число, которое мы поместим в клетку с координатами tekR и tekC.

строки 5 - 7: удаляем всю информацию с текущего листа и делаем ячейки квадратными.

строки 8 - 12: присваиваем начальные значения.

строки 13 - 39: заполнение по спирали (стр. 14 - 19 двигаемся вправо, стр. 20 - 25 - вверх, стр. 26 - 31 - влево, 32 - 37 - вниз, после чего в стр. 38 увеличиваем шаг на 2 и пошли по новой).

строки 40 - 49: проверка простоты числа и форматирование клетки в зависимости от этого.

строки 50 - 52: выделяем нашу "скатерть" и ставим масштаб листа "по выделению".

В конечном итоге, получаем такую картину:



Такие параметры , как первое число (ведь это не обязательно 1) и размеры таблицы (параметр limit) стоит вводить через диалоговое окно.

Примечательным является то, что простые числа выстраиваются вдоль диагональных прямых.

Похожие по тематике посты - еще почитать:

Комментариев нет:

Отправить комментарий