Помогите создать файл для изучения английских слов. Вкратце: файл должен брать слова из "Словарь" и в виде теста выводиться в "Проверка". Буду очень благодарен, если поможете. Если тема не соответствует данной проблеме, прошу модераторов изменить название.
Добрый день. Озвучьте, что конкретно у вас не получается сделать? Если надо с нуля все сделать, и неохота делать самому - можно сразу в раздел Работа обратиться.
В целом несколько бессмысленное занятие учить слова вот так. infidelity у вас там очень смешно смотрится без контекста. Особенно рядом с be was... На одно русское "измена" английских слов будет десяток навскидку. С непересекающимися значениями. И для "быть" вы реально хотите требовать ввод всех четырех форм ровно через один пробел? И в виде вопроса - все 4 слова, которые надо перевести словом "быть"? Из них "быть" - это только первое, и то...
Option Explicit
'Для старта.
Sub Start()
PrintWord GetDirection() + 1
End Sub
'Для смены направления перевода.
Sub ChangeDirection()
With Sheets("Проверка").Range("E1")
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Value = "eng"
Else
.Value = Empty
End If
Application.EnableEvents = True
End With
End Sub
Function GetDirection() As Byte
Dim direction As Byte
With Sheets("Проверка").Range("E1")
If IsEmpty(.Value) Then
direction = 0
Else
direction = 1
End If
End With
GetDirection = direction
End Function
Function GetArr() As Variant
Dim arr As Variant
Dim y As Long
With Sheets("Словарь")
y = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range(.Cells(1, 1), .Cells(y, 2))
End With
GetArr = arr
End Function
Sub PrintWord(ByVal x As Byte)
Dim arr As Variant
Dim y As Long
arr = GetArr()
If x < 1 Or x > UBound(arr, 2) Then x = 1
With Sheets("Проверка")
y = .Cells(.Rows.Count, 1).End(xlUp).Row
y = y + 1
If y > 30 Then Exit Sub
Dim r As Range
Set r = .Cells(y, 1)
Randomize
y = Rnd() * (UBound(arr, 1) - 1) + 1
If y < 2 Then y = UBound(arr, 1)
r.Value = arr(y, x)
.Select
Application.EnableEvents = False
r.Cells(1, 2).Select
Application.EnableEvents = True
End With
End Sub
В модуль листа Проверка.
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.Column = 2 Then
If Target.Row <= 30 Then
If Target.Value <> "" Then
Dim arr As Variant
arr = GetArr()
Dim d As Byte
d = GetDirection()
Dim s1 As String
Dim s2 As String
With Cells(Target.Row, Target.Column - 1)
s1 = LCase(.Cells(1, 1 + d).Value)
s2 = LCase(.Cells(1, 2 - d).Value)
End With
Dim y As Long
Dim b As Boolean
b = False
For y = 1 To UBound(arr, 1)
If LCase(arr(y, 1)) = s1 Then
If LCase(arr(y, 2)) = s2 Then
b = True
End If
Exit For
End If
Next
If b Then
PrintWord d + 1
Else
Application.EnableEvents = False
Target.Value = Empty
Target.Select
Application.EnableEvents = True
End If
End If
End If
End If
End If
End Sub
Xel, Данная затея нужна чтобы просто пополнять словарный запас с возможностью практиковать писать и повторять их. Я тут указал что первое в голову пришло, но Ваше замечание для меня понятно. В будущем хотел бы заиметь такой же файл, если бы получилось с простыми словами, и к неправильным глаголам. Там бы было три строки, где нужно было бы вводить ответ.
gog843 написал: Я тут указал что первое в голову пришло
У меня просто как-то слегка задергался глаз, при виде не очень простого слова, не имеющего аналога в русском языке и переводящегося как "измена" только строго в определенном контексте, рядом с глаголом to be. Не говоря уже о том, что сколько-нибудь адекватный обратный перевод без контекста вообще невозможен, потому что английских слов там много. И в словосочетаниях "измена союзника", "измена мужа" и "супружеская измена" - это будет 3 разных слова. И даже не 3. Ну то есть механически задачу вам решили, но задачу изучения английских слов оптовыми партиями по 30 штук обычно так не решают, оно так не работает.