我遇到IF的问题,当我选中复选框时禁用,然后功能仍为我的行着色。我正在尝试获得的解决方案是,对于选中的复选框行为绿色,未选中的行为空白或其他颜色。
这是我的代码:
Sub CheckBoxDate()
Dim ws As Worksheet
Dim chk As CheckBox
Dim lColD As Long
Dim lColChk As Long
Dim lRow As Long
Dim rngD As Range
lColD = 0 'number of columns to the right for date
Set ws = Sheets("MA Template_VBack-End")
Set chk = ws.CheckBoxes(Application.Caller)
lRow = chk.TopLeftCell.Row
lColChk = chk.TopLeftCell.Column
Set rngD = ws.Cells(lRow, lColChk + lColD)
Select Case chk.Value
Case 1 'box is checked
For Each chk In ws.CheckBoxes
If ws.Range("C" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("D" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("E" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("f" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("g" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("i" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("t" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("u" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("z" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ab" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ac" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ap" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("at" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bs" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bt" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bu" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
ElseIf ws.Range("bv" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bx" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bz" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ca" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cc" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cd" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ce" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ci" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ck" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cl" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cm" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cn" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("co" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cp" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cq" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cs" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
ElseIf ws.Range("ea" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ed" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ee" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eg" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eh" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ei" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ej" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
Else
rngD.EntireRow.Interior.Color = vbGreen
chk.Value = True
End If
Next chk
Case Else 'box is not checked
chk.Enabled = True
rngD.ClearContents
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
End Select
End Sub
主要问题应该在这里,我不确定我是否使用正确的情况
Select Case chk.Value
Case 1 'box is checked
For Each chk In ws.CheckBoxes
If ws.Range("C" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("D" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("E" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("f" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("g" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("i" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("t" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("u" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("z" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ab" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ac" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ap" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("at" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bs" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bt" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bu" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
ElseIf ws.Range("bv" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bx" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bz" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ca" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cc" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cd" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ce" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ci" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ck" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cl" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cm" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cn" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("co" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cp" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cq" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cs" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
ElseIf ws.Range("ea" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ed" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ee" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eg" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eh" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ei" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ej" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
Else
rngD.EntireRow.Interior.Color = vbGreen
chk.Value = True
End If
Next chk
Case Else 'box is not checked
chk.Enabled = True
rngD.ClearContents
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
End Select
感谢您的帮助!
答案 0 :(得分:0)
问题可能出在Case声明中。您可能需要调整它来说:
Select Case chk.Value
Case Is = 1
而不是
Case 1
检查chk的值
答案 1 :(得分:0)
免责声明:以下代码很可能不是您想要的,但它可能会帮助您实现目标。
Sub CheckBoxDate()
' 17 Apr 2017
Dim Ws As Worksheet
Dim Chk As CheckBox
Dim DateShift As Long ' shift number of columns to the right for date
Dim Rng As Range
Dim RngColor As Long
Dim Clms As String
DateShift = 0
Set Ws = Sheets("MA Template_VBack-End")
' This line of code has wrong syntax: What do you want?
' Set Chk = Ws.CheckBoxes(Application.Caller)
Set Chk = Ws.CheckBoxes("Check Box 4")
' Chk.TopLeftCell is already a range object: no need to re-define it
Set Rng = Chk.TopLeftCell.Offset(0, DateShift)
Chk.Value = 1 ' default
RngColor = vbGreen
Clms = "C,D,E,F,G,I,T,U,Z,AB,AC,AP,AT,BS,BT,BU"
If IsNullString(Clms, Chk.TopLeftCell.Row, Ws) Then
Chk.Value = -4146 ' not checked
RngColor = 16777215 ' no color
End If
Clms = "BV,BX,BZ,CA,CC,CE,CI,CK,CL,CM,CN,CO,CP,CQ,CS,EA,ED,EE,EG,EH,EI,EJ"
If IsNullString(Clms, Chk.TopLeftCell.Row, Ws) Then
Chk.Value = -4146 ' not checked
RngColor = vbRed
End If
Rng.EntireRow.Interior.Color = RngColor
' Chk.Enabled = True ' can't tell the intention of this
' Rng.ClearContents ' can't tell when this should be done
End Sub
Private Function IsNullString(Clms As String, _
R As Long, _
Ws As Worksheet) As Boolean
' 17 Apr 2017
Dim C() As String
Dim i As Integer
C = Split(Clms, ",")
For i = UBound(C) To 0 Step -1
If Ws.Cells(R, Columns(C(i)).Column).Value = vbNullString Then Exit For
Next i
IsNullString = (i = Not True)
End Function
您的代码中有很多部分根本无法理解。因此,我试图将一个概念带入你的想法,这个概念是可以理解的,因此可以修改为你想做的事。
我发现的问题是你们都在询问复选框的值并设置它们的值。这只能在非常严格控制的条件下工作,而这种条件并不存在。因此,我的代码尝试为操作带来订单。首先,设置默认值。然后更改默认值。我想您可能只想在特定条件下进行更改。上面的代码将允许您轻松地执行此操作。
也可以轻松地将代码放入循环中以遍历工作表中的所有复选框。我故意没有尝试实现它,因为它应该只在单个循环成功运行后才能完成,包括调用的方法肯定不会按照你编程的方式工作。此外,您想要的颜色范围显示不明确。
我希望你会发现我添加的小功能很有帮助。它需要大量的代码,并且工作得更快,因为它不需要检查所有列:如果找到一个NullString,则条件已经满足。我建议你尝试修改这段代码以满足更多的要求,然后或许可以回过头来回顾最终结果。
答案 2 :(得分:0)
非常感谢你的帮助和许多帮助我找到错误的文字,还教你很多关于VBA的事情。
解决我问题的方法(也许这不是最好的,根据@Variatus,我可以做得更好,但我需要更多练习来理解VBA)
工作代码:
Select Case chk.Value
Case Is = 1 'box is checked
If ws.Range("C" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("D" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("E" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("f" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("g" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("i" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("t" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("u" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("z" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ab" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ac" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ap" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("at" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bs" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bt" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bu" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
ElseIf ws.Range("bv" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bx" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("bz" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ca" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cc" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cd" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ce" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ci" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ck" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cl" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cm" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cn" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("co" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cp" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cq" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("cs" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
ElseIf ws.Range("ea" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ed" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ee" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eg" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("eh" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ei" & chk.TopLeftCell.Row).Value = vbNullString Or ws.Range("ej" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
rngD.EntireRow.Interior.Color = vbRed
Else
rngD.EntireRow.Interior.Color = vbGreen
End If
Case Else 'box is not checked
chk.Enabled = True
rngD.ClearContents
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
End Select
方案: 1.选中复选框 - 行为绿色并选中复选框 2.未选中复选框 - 行是默认颜色,未选中复选框 3.行中必需的单元格为空 - 未选中复选框,行为红色
非常感谢您的协助!
答案 3 :(得分:0)
这是我对它的刺痛。据我所知,您的部分问题可能在于您如何接近动态更新。我注意到,在重写你的代码时,你在这里有一点点消息:
Set rngD = ws.Cells(lRow, lColChk + lColD)
如果我的预感是正确的,你会认为这是一个公式。值得注意的是,一旦设置了这个引用,它就不会改变它的目标,因为用于设置它的变量会发生变化。因此,例如,如果lRow为5,则设置rngD,然后lRow更改为6 rngD仍将指向第5行。
我可能会弄错,但这可能是问题的一部分。
请参阅下面我的代码版本:
Sub CheckBoxDate()
Dim lColD As Long
lColD = 0 'number of columns to the right for date
Dim ws As Worksheet
Set ws = Sheets("MA Template_VBack-End")
Dim chk As CheckBox
Set chk = ws.CheckBoxes(Application.Caller)
Dim lRow As Long
lRow = chk.TopLeftCell.Row
Dim lColChk As Long
lColChk = chk.TopLeftCell.Column
' From what I can tell, you want this to dynamically update the row. As is, it will only ever be this row.
' Set rngD = ws.Cells(lRow, lColChk + lColD)
Dim ColArray_1 As Variant
ColArray_1 = Array("C", "D", "E", "F", "G", "I", "T", "U", "Z", "AB", "AC", "AP", "AT", "BS", "BT", "BU")
Dim ColArray_2 As Variant
ColArray_2 = Array("BV", "BX", "BZ", "CA", "CC", "CD", "CE", "CI", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CS")
Dim ColArray_3 As Variant
ColArray_3 = Array("EA", "ED", "EE", "EQ", "EH", "EI", "EJ")
Dim col As Variant
Dim LoopRow As Long
Dim LoopCheck As CheckBox
Dim ConditionCheck As Boolean
Dim rngD As Range
If chk.value = 1 Then
For Each LoopCheck In ws.CheckBoxes
ConditionCheck = False
LoopRow = chk.TopLeftCell.Row
For Each col In ColArray_1
If ws.Range(col & LoopRow).value = vbNullString Then
LoopCheck.value = False
Set rngD = ws.Cells(LoopRow, lColChk + lColD)
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
ConditionCheck = True
Exit For
Next
If Not ConditionCheck Then
For Each col In ColArray_2
If ws.Range(col & LoopRow).value = vbNullString Then
LoopCheck.value = False
Set rngD = ws.Cells(LoopRow, lColChk + lColD)
rngD.EntireRow.Interior.Color = vbRed
ConditionCheck = True
Exit For
Next
End If
If Not ConditionCheck Then
For Each col In ColArray_3
If ws.Range(col & LoopRow).value = vbNullString Then
LoopCheck.value = False
Set rngD = ws.Cells(LoopRow, lColChk + lColD)
rngD.EntireRow.Interior.Color = vbRed
ConditionCheck = True
Exit For
Next
End If
If Not ConditionCheck Then
Set rngD = ws.Cells(LoopRow, lColChk + lColD)
rngD.EntireRow.Interior.Color = vbGreen
chk.value = True
End If
Next
Else
LoopCheck.Enabled = True
rngD.ClearContents
rngD.EntireRow.Interior.ColorIndex = xlColorIndexNone
End If
End Sub
我使用循环来克服其他非常丑陋且令人难以置信的错误或语句。在这种情况下,只要它找到满足条件的东西,它就会设置格式并继续前进。这也演示了如何设置单个控制变量进行循环。另外值得注意的是,第三个和第四个循环对行具有相同的效果,因此您可以合并它们,并合并ColArray的2和3。
我无法测试此代码,因为我没有你的工作表,并且CheckBox没有出现在Intellisense中(至少在我声明变量时,我可以看到属于它的方法)。希望它可以帮到你,或者至少让我们更接近。
答案 4 :(得分:0)
正如我在上面的评论中所承诺的,这是一种间接解决方案,一种以有序和及时的方式解决问题的方法,例如在编写程序之前确定调用程序的方法。你已经完成的大部分工作最终都可以纳入。这些代码片段可以添加到这个"过程"因为概念被代码和问题所取代。我的观点是创建一个蓝图,这个蓝图将导致可以研究和回答的问题,并让您走上成功的明确道路。
Private Sub ProjectPlan()
' 18 Apr 2017
Dim Ws As Worksheet
Dim Chk As CheckBox
' Set Ws = Sheets("MA Template_VBack-End")
Set Ws = Sheets("Ttrx")
' determine how to call this procedure
' create and test the calling process
' ===== my inclination is to say that you will need ActiveX controls for that =====
' Create a macro to set the OnAction property of all checkboxes
' in the worksheet to point to this procedure. (don't do this manually: unreliable)
' determine whether to run the proc manually or with one of
' the worksheet events (such as Open or Save)
' You will need to have access to the clicked Chk object
' assign a meaningful name to this Chk
' test setting its Value property
' I presume that you will want to know the row in the
' worksheet on which the Chk was clicked.
' ===== Could there be more than 1 Chk in a row? =====
' create the functionality and test it
' assign a meaningful variable name to this important row
' Define the range in this row which would be subject to coloring
' Assign a meaningful name to this range
' Determine colours: Default = no colour, Check = Green, Uncheck = Red
' devise a method by which to create all THREE colours
' ===== How will you create 3 colours with True & False? =====
' test the system you have devised on one Chk
' test colouring the range you have determined by the system
' you have devised: one Chk only at this time, meaning one row only.
' +++++++++++++++++++++++++++++++++++++++++++++
' Create a written description of your basic system,
' if you haven't done so already
' Resolve these problems:-
' 1. When the sheet is loaded it is white, red and green as saved (correct?)
' You might change that status using the Workbook Open event.
' 2. When a Chk is clicked it changes from True to False or v.v. (of course)
' ===== This action calls the macro (correct?)
' 3. Then the macro evaluates certain cells in the same row
' ==== Does it change the Chk to something else? ====
' 4. Then the macro looks at the final setting of the Chk
' and colours the row according to the Chk.Value
' ==== But the Chk has only True & False, red and green.
' ==== When to colour white?
' The way I understand your idea now is that checking the Chk
' indicates your wish to check which results in red or green colouring
' while the Chk.Value is actually revised by the code.
' ==== Careful not to create a loop where the change made by the code
' calls the same procedure. =====
' If your intention is to just check and colour, returning the
' Chk to unchecked in every case, consider using a button instead.
' Either way, it isn't clear how you can return a row to "no colour"
' unless you remove all colouring on Save or Close or Open.
' +++++++++++++++++++++++++++++++++++++++++++++
' You seem to want to loop through all Chks in the worksheet
' whenever one of the Chks is clicked. ===== Is that correct? =====
' This will be very, very slow.
' Consider not checking the entire sheet on every click.
' Create a loop to call other Chks you want to call
' test the loop first with one, then with 2, then 3 Chks
' Any mopping up to do?
' Consider returning certain cells to their original, colourless state
' only after the program has run its course.
' This is an alternative to doing so before it runs.
End Sub