Страницы: 1
RSS
Макрос для раставления вперемежку чисел от min до max, упражнения для запоминания чего-либо
 
День добрый.
Нередко возникает необходимость запоминать какие-то соответствия, когда каждому образу из одного множества, соответствует какой-то образ из другого множества. Например таблица умножения на какое-то число. Или слова из другого языка. Я учил квадраты чисел до 40.
Я хотел, чтобы в столбце А появлялись числа от 1 до 40, но каждый раз вперемешку. Чтоб я рядом записывал квадрат этого числа, а затем формулой в столбце С получал результат:
Код
=A10*A10
А в столбце Д видел результат.
Код
=B10=C10
Столбцы С и Д отформотировал, чтобы шрифт был прозрачным. И текст можно было бы посмотреть, только при выделении целого столбца.
А затем на этом листе я поместил следующий макрос.
Код
Sub Макрос1()
    Dim i As Integer
    Dim max As Integer
    Dim min As Integer
    Dim MyCollection As New Collection
    min = 1
    max = 40
    With MyCollection
        For i = min To max
            .Add (i)
        Next i
    For i = 1 To .Count
        MyValue = Int(((max - i + 1) * Rnd) + 1)
        Cells(i, 1) = .Item(MyValue)
        .Remove (MyValue)
    Next i
    End With
End Sub
Таким образом, запустив макрос, у меня в столбце А появлялись числа от 1 до 40 в случайном порядке, но каждое только один раз. Затем я вручную в стоблце Б проставлял результат возведения в квадрат этого числа. А затем выделяя столбец Д видел либо "Истина" либо "ЛОжь".
При желании в столбце С можно вместо квадрата числа, прописать формулу ВПР() с обращением на другой лист, на котором заранее сделать таблицу из трех столбцов. В первом номер строки, т.е. число от одного до 40, во втором слово на русском языке, и в третьем перевод этого слова на нужный язык. И подтягивать на первый лист значения сначала из второго столбца. Ну и сравнивать с третьим. Таким образом много раз напечатав напротив русского слова слово на другом языке, вы может быть его скоро запомните  ;)
Если автоматизировать бардак, то получится автоматизированный бардак.
 
Вот макрос, который заполняет выделенный диапазон случайными целыми числами которые будут между двумя указанными вами числами
Код
Sub случайные_числа()
Dim a(), b(), i&, k&, per&, vto&, mini&, maxi&, sac&, x&, y As Integer, o As Object
per = Application.InputBox("Введите числовое значение", "ПЕРВОЕ ЧИСЛО", , , , , , 1)
vto = Application.InputBox("Введите числовое значение", "ВТОРОЕ ЧИСЛО", , , , , , 1)
mini = Application.WorksheetFunction.Min(per, vto)
maxi = Application.WorksheetFunction.Max(per, vto)
Set o = CreateObject("Scripting.Dictionary")
sac = Selection.Areas.Count
For i = 1 To sac
    If IsArray(Selection.Areas(i)) Then
        a = Selection.Areas(i).Value
        For x = 1 To UBound(a)
            For y = 1 To UBound(a, 2)
                a(x, y) = WorksheetFunction.RandBetween(mini, maxi)
            Next
        Next
        o(i) = a
        Erase a
    Else
        ReDim b(1 To 1, 1 To 1)
        b(1, 1) = WorksheetFunction.RandBetween(mini, maxi)
        o(i) = b
        Erase b
    End If
Next
For k = 1 To sac
    Selection.Areas(k).Value = o(k)
Next
End Sub
 
Так такая же логика макроса, только для прямоугольника. И практического применения такому я пока придумать не могу. А моим вариантом я предложил как пользоваться.
Если автоматизировать бардак, то получится автоматизированный бардак.
Страницы: 1
Наверх