Я новичок в vba и мне нужна помощь. В настоящее время у меня есть раскрывающийся список в определенном столбце (E1: E519), где сотрудники могут выбрать галочку или оставить его пустым. Однако, если у кого-то есть 400 человек или около того, для которых нужно поставить галочки, это может раздражать. Так что это побудило меня создать командную кнопку сбоку, используя vba, чтобы выбрать и отменить выбор всего в этом конкретном диапазоне столбцов.
Как создать код vba, который позволяет проверкам заполнять только пробелы в выбранном диапазоне в ячейках, у которых есть опция раскрывающегося списка (в раскрывающемся списке есть только 1 опция, которая является галочкой). Выпадающий список должен оставаться для пользователей, которые предпочитают устанавливать каждый флажок отдельно, а не использовать командную кнопку. Столбец E либо получает галочку, либо остается пустым. Было бы намного проще, если бы он распознавал, что если в столбце B есть данные, то галочка должна быть добавлена к столбцу E в той же строке. Если есть код для этого, я был бы признателен за всю помощь, которую я могу получить. Точная галочка, которую я использую, — это шрифт Arial Unicode MS с подмножеством кода символа Dingbat 2713.
Может кто-нибудь помочь мне и показать мне, как это сделать правильно? Я также был бы признателен за небольшое объяснение, чтобы я мог понять язык кода и продолжить обучение. Благодарю вас!
Текущий код, который я использую (показывает «?» вместо галочки, расположенной в ячейке E14 (строка 14, столбец 5), которая является галочкой):
Private Sub CommandButton1_Click()
Dim c As Range
Dim check As Long
check = 0 'Define 0 for crossmark or 1 for checkmark
For Each c In Range("E17:E519") '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 check = 1, then
.Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
.Font.Size = 12 'Font size
.FormulaR1C1 = "ü" 'special character for checkmark
ElseIf check = 0 Then 'If cehck = 1, then
.Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
.Font.Size = 12 'Font size
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.FormulaR1C1 = "?"
End If
End With
End If
Next c
End Sub
Следующий код
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("NFLES ILT Form") '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("E17:E519") '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(14, "E").Copy 'Copy from cell(14,5) where cells(row number, column number). This will copy row 14, column 5, which is cell E14
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
End Sub
в конце? Что вы пробовали? - person BruceWayne   schedule 24.10.2018