VBA Excel 2013 列范围与要创建的下拉列表 VBA 代码 Select 全部并取消选择所有复选标记
VBA Excel 2013 Column Range with Drop Down List to Create VBA Code to Select All & Deselect All Check Marks
我是 vba 的新手，需要帮助。目前，我在特定列 (E1:E519) 中有一个下拉列表，工作人员可以在其中选择复选标记或将其留空。但是，如果有人要为 400 人左右的人打勾，这可能会很烦人。因此，这促使我在该特定列范围内使用 vba 到 select 和 deselect 在侧面创建一个命令按钮。
如何创建一个 vba 代码，该代码只允许检查填充具有下拉列表选项的单元格中 selected 范围内的空白（其中只有 1 个选项）下拉列表，这是一个复选标记）。对于喜欢单独选中每个框而不使用命令按钮的用户，必须保留下拉列表。 E 列要么得到支票，要么留空。如果它认识到如果 B 列有数据，那么应该在同一行的 E 列上添加一个复选标记，这会容易得多。如果有代码，我一定会感谢我能得到的所有帮助。我使用的确切复选标记是带有子集 Dingbat 字符代码 2713 的 Arial Unicode MS 字体。
有人可以帮助我并告诉我如何正确地做吗？我也很感激一些解释，以便我可以理解代码语言并进一步学习。谢谢！
我正在使用的当前代码（显示“？”而不是位于单元格 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
这里棘手的部分是你为 crossmark/ticker 使用了什么样的字符。所以我列出了两种方法，这是我之前使用的第一种方法。
因为我希望它在宏和下拉列表中都标准化，所以我在单元格 B1 和 B2 中选择一个字符集作为虚拟变量。
B1 = 勾号 (✓) = 1 和 B2 = 叉号 (✗) = 0。最大的好处是我可以在 drop down-list（见图）和 VBA 代码中使用相同的字符。请注意，我的单元格 B1 和 B2 都有 drop-down 列表。当我的代码复制这些单元格时，drop-down 列表将跟随新单元格。
当我运行代码时，我首先需要选择1或0。您选择什么取决于代码将复制复选标记（值 1）还是十字标记（值 0）。
下一个 window 是您定义范围的地方。你可以这样写：E20:E50 或者你可以 select 用你的鼠标 select 来写它。
然后代码处理，结果将更改为单元格：
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 是您要更改的范围 check/crossmarks
替代方法：
此代码使用字体大小"Wingding"。
此处的缺点是您无法在drop-down列表中以"good"方式使用此样式。您将拥有值“ü”= ✓ 和 û = ✗。这意味着在 drop-down 列表中你会有你的，但在宏中它会在结果出现时显示正确的值。
优点 是您不需要任何虚拟单元格，因为代码不会复制任何单元格。它直接从代码中写入值。如果您遇到只想使用宏而不想使用 drop-down 列表的情况，这可能是一个完美的方法。
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 列中的单元格是否而非 为空。如果单元格不为空（returns: "" 的公式被视为空），它将从虚拟单元格 A1 复制值并粘贴到同一行的 E 列中。
注意使用 data-validation 和复选标记 ✓ 设置虚拟单元格。原因是字符 2713 是一个特殊字符，在 VBA 中它会导致“？”特点。因此，我们将其复制到 excel 环境中，以便正确处理它，包括 drop-down 列表
代码集中的变量：
工作表名称，pre-defined为："Sheet1"
查找数据的范围："B1:B519"
ws.Cells(1, "A").Copy - 虚拟变量所在的单元格 ("A1").
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
我是 vba 的新手，需要帮助。目前，我在特定列 (E1:E519) 中有一个下拉列表，工作人员可以在其中选择复选标记或将其留空。但是，如果有人要为 400 人左右的人打勾，这可能会很烦人。因此，这促使我在该特定列范围内使用 vba 到 select 和 deselect 在侧面创建一个命令按钮。
如何创建一个 vba 代码，该代码只允许检查填充具有下拉列表选项的单元格中 selected 范围内的空白（其中只有 1 个选项）下拉列表，这是一个复选标记）。对于喜欢单独选中每个框而不使用命令按钮的用户，必须保留下拉列表。 E 列要么得到支票，要么留空。如果它认识到如果 B 列有数据，那么应该在同一行的 E 列上添加一个复选标记，这会容易得多。如果有代码，我一定会感谢我能得到的所有帮助。我使用的确切复选标记是带有子集 Dingbat 字符代码 2713 的 Arial Unicode MS 字体。
有人可以帮助我并告诉我如何正确地做吗？我也很感激一些解释，以便我可以理解代码语言并进一步学习。谢谢！
我正在使用的当前代码（显示“？”而不是位于单元格 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
这里棘手的部分是你为 crossmark/ticker 使用了什么样的字符。所以我列出了两种方法，这是我之前使用的第一种方法。
因为我希望它在宏和下拉列表中都标准化，所以我在单元格 B1 和 B2 中选择一个字符集作为虚拟变量。
B1 = 勾号 (✓) = 1 和 B2 = 叉号 (✗) = 0。最大的好处是我可以在 drop down-list（见图）和 VBA 代码中使用相同的字符。请注意，我的单元格 B1 和 B2 都有 drop-down 列表。当我的代码复制这些单元格时，drop-down 列表将跟随新单元格。
当我运行代码时，我首先需要选择1或0。您选择什么取决于代码将复制复选标记（值 1）还是十字标记（值 0）。
下一个 window 是您定义范围的地方。你可以这样写：E20:E50 或者你可以 select 用你的鼠标 select 来写它。
然后代码处理，结果将更改为单元格：
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 是您要更改的范围 check/crossmarks
替代方法：
此代码使用字体大小"Wingding"。
此处的缺点是您无法在drop-down列表中以"good"方式使用此样式。您将拥有值“ü”= ✓ 和 û = ✗。这意味着在 drop-down 列表中你会有你的，但在宏中它会在结果出现时显示正确的值。
优点 是您不需要任何虚拟单元格，因为代码不会复制任何单元格。它直接从代码中写入值。如果您遇到只想使用宏而不想使用 drop-down 列表的情况，这可能是一个完美的方法。
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 列中的单元格是否而非 为空。如果单元格不为空（returns: "" 的公式被视为空），它将从虚拟单元格 A1 复制值并粘贴到同一行的 E 列中。
注意使用 data-validation 和复选标记 ✓ 设置虚拟单元格。原因是字符 2713 是一个特殊字符，在 VBA 中它会导致“？”特点。因此，我们将其复制到 excel 环境中，以便正确处理它，包括 drop-down 列表
代码集中的变量：
工作表名称，pre-defined为：
"Sheet1"查找数据的范围：
"B1:B519"ws.Cells(1, "A").Copy- 虚拟变量所在的单元格 ("A1").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