Сложность в том, какой тип символа вы использовали для перекрестной пометки / тикера.Поэтому я перечисляю два подхода, первый из которых я использовал ранее.
Поскольку я хочу, чтобы он был стандартизирован как в макросах, так и в раскрывающемся списке, я выбираю набор символов в ячейках B1 и B2 в качестве фиктивных переменных.
B1 = галочки (✓) = 1 и B2 = метки (✗) = 0.Большим преимуществом является то, что я могу использовать те же символы в раскрывающемся списке (см. Рисунок) и код VBA.Обратите внимание, что обе мои ячейки, B1 и B2, имеют раскрывающиеся списки.Когда мой код скопирует эти ячейки, выпадающий список будет следовать за новыми ячейками.
Когда я запускаю код, мне сначала нужно выбрать1 или 0.То, что вы выберете, зависит от того, скопирует ли код галочки (значение 1) или перекрестные метки (значение 0).
Следующее окногде вы определяете свой диапазон.Вы можете написать его так: E20:E50 или выбрать его, щелкнув мышью.
Затем код обрабатывается, и результат будетизменить ячейки:
Код VBA:
Sub change_cells_ref()
Dim c As Range
Dim check_or_cross As Variant
Dim c_row_number As Long
Dim rangeinput As Variant
check_or_cross = Application.InputBox("Enter ""1"" for checkmark or ""0"" for crossmark") 'Input box for checkmarks (enter: 1) or crossmarks (enter: 0)
On Error Resume Next 'If error occurs, this is not a good way to mask errors... but if you press cancel in the inputbox when you are setting a range, VBA automatically throws an error: 13 before we can catch it, so we mask any errors that can occurs.
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8) ' Input box for Range, Type:=8 tells us that the value has to be in range format. You could either select or write range.
For Each c In rangeinput 'Range("E17:E150") - remove "rangeinput" to have a static range. This line defines your range where you are look for "zxyx", then loop through that range.
c_row_number = c.Row 'Gives us the current row for the loop variable c which we are looping.
If c <> "zxyz" Then 'Checks if the value is combination that is very unlikely to occur. It will overwrite all those values that are not "zxyz".
'If you replace the above code line with [If c = "" Then] the code would only overwrite cells that has not checkmark or crossmark...i,e only empty cells, could be good if you have some workers who answered, and some that hasn't. And only want to fill in those who didn't answer quickly.
With c 'Define what you want to do with the variable c
If check_or_cross = 1 Then 'If the user wrote 1, then copy checkmarks
.Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
.Font.Size = 12 'Set the Font size
Cells(1, 2).Copy 'Copy from cell(1,2) where cells(row number, column number). This will copy row 1, column 2, which is cell B1
Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
ElseIf check_or_cross = 0 Then 'If the user wrote 0, then copy crossmarks
.Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
.Font.Size = 12 'Set the Font size
Cells(2, 2).Copy 'Copy from cell(2,2) where cells(row number, column number). This will copy row 2, column 2, which is cell B2
Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
End If 'End the if statement (if check_or_cross is 1 or 0)
End With 'Close the With c part
End If 'End the if statement where we check which value c has.
Next c 'Go to next c in the range
On Error GoTo 0
End Sub
Если вы всегда хотитестатический диапазон и пропустите поле ввода для части диапазона, вы можете удалить эти 3 строки:
On Error Resume Next
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8)
'...code....
On Error GoTo 0
и затем заменить эту часть For Each c In rangeinput -> For Each c In Range("E17:E517") - где E17:E517 - ваш диапазончто вы хотите изменить галочки / пометки
Альтернативный подход:
В этом коде используется размер шрифта "Wingding".
Недостаток в том, что вы не можете использовать этот стиль "хорошим" способом в раскрывающемся списке.У вас будут значения "ü" = ✓ и для û = ✗.Это означает, что в раскрывающемся списке у вас будут символы «u», но в макросе он покажет правильные значения при представлении результата.
Преимущество в том, что вам не нужны пустые ячейки, так как код не будет копировать никакие ячейки.Он записывает значения прямо из кода.Если у вас есть случай, когда вы хотите использовать только макрос, а не раскрывающийся список, это может быть идеальным подходом.
Sub change_cells()
Dim c As Range
Dim check As Long
check = 0 'Define 0 for crossmark or 1 for checkmark
For Each c In Range("E17:E150") 'Define your range which should look value not equal to 1, then loop through that range.
If c <> 1 Then 'check if value in range is not equal to 1
With c 'Define what you want to do with variable c
If check = 1 Then 'If cehck = 1, then
.Font.Name = "Wingdings" 'Apply font "Wingdings"
.Font.Size = 12 'Font size
.FormulaR1C1 = "ü" 'special character for checkmark
ElseIf check = 0 Then 'If cehck = 1, then
.Font.Name = "Wingdings" 'Apply font "Wingdings"
.Font.Size = 12 'Font size
.FormulaR1C1 = " û " 'special character for crossmark
End If
End With
End If
Next c
End Sub
Другой легкий подход показан в результате ниже:
Код будет выглядеть, еслиячейка в столбце B не пуста.Если ячейка не пустая (формулы, которые возвращаются: "" обрабатываются как пустые), она скопирует значение из фиктивной ячейки A1 и вставит в столбец E в той же строке.
Примечаниеустановить фиктивную ячейку с проверкой данных и галочкой ✓.Причина в том, что символ 2713 является специальным символом, и в VBA он будет иметь результат "?"персонаж.Поэтому мы копируем его в среду Excel, где он может обрабатываться правильно, включая раскрывающийся список
Переменные в наборе кодов:
Имя листа, предварительно определенное как: "Sheet1"
Диапазон, в котором нужно искать данные: "B1:B519"
ws.Cells(1, "A").Copy - ячейка, где находится пустышкапеременная расположена («А1»).
ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll - Установить столбец, в который должна быть вставлена галочка.
VBAКод:
Sub change_cells_ref2()
Dim ws As Worksheet
Dim c As Range
Dim c_row_number As Long
Dim rangeinput As Variant
Set ws = Worksheets("Sheet1") 'Define the worksheet the code should be applied to
Application.ScreenUpdating = False 'Turn off screen update, makes the calculations more smooth and faster.
Set rangeinput = Range("B1:B519") 'Set Range where you want to check if the variable c is empty. If you have headers, set "B2:B519"
For Each c In rangeinput 'This line defines your range where you are looking for "", then loop through that range.
c_row_number = c.Row 'Gives us the current row number for the loop variable c which we are looping.
If c <> "" Then 'Checks if the value in variable c is empty
ws.Cells(1, "A").Copy 'Copy from cell(1,1) where cells(row number, column number). This will copy row 1, column 1, which is cell A1
ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
End If 'End the if statement where we check which value variable c has.
Next c 'Go to next c in the range
Application.CutCopyMode = False 'Cancel any copy selection
Application.ScreenUpdating = True 'Turn off screen update
End Sub