单元格上的Excel自动input三angular形

这里是我有的代码，当我input0时，它会完美的工作，它会创build一个对angular线，每个单元格我input0

Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Variant Dim rng1 As Range, rng2 As Range Dim addr As String Set Target = Range("C10:AA36,C44:AA68") If Intersect(Target, ActiveCell) Is Nothing Then Exit Sub For Each c In Target If c = 0 And Len(c) <> 0 Then addr = c.Address With Range(addr).Borders(xlDiagonalDown) .LineStyle = xlContinuous End With ElseIf c > 0 And Len(c) > 0 Then addr = ActiveCell.Address With Range(addr).Borders(xlDiagonalDown) .LineStyle = xlNone End With End If Next End Sub 

我有一个问题，添加一个选项为我添加的每个单元格添加一个三angular形形状时，我键入1直angular三angular形然后2倒三angular形

Answer 1

关于你的代码的一些意见/build议：

• 由于您正在使用Worksheet_Change事件。 您可以充分利用定义为Range的Target对象，并将其设置为ActiveCell 。 因此，您的代码中的每个地方都可以用Targetreplaceaddr = c.Address和Range(addr) 。
• 我用Select Case取代了你的If ，这样在将来你可以很容易地添加更多的形状。

码

 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng1 As Range Set Rng1 = Range("C10:AA36,C44:AA68") If Not Intersect(Target, Rng1) Is Nothing Then Application.EnableEvents = False If Len(Target.Value) > 0 Then ' -- first clear the previous formatting -- Target.Borders.LineStyle = xlNone Target.Borders(xlDiagonalDown).LineStyle = xlNone Select Case Target.Value Case 0 ' create diagonal line Target.Borders(xlDiagonalDown).LineStyle = xlContinuous Case 1 ' create right triangle Target.Borders(xlDiagonalDown).LineStyle = xlContinuous Target.Borders(xlEdgeBottom).LineStyle = xlContinuous Target.Borders(xlEdgeLeft).LineStyle = xlContinuous Case 2 ' create up-side down triangle Target.Borders(xlDiagonalDown).LineStyle = xlContinuous Target.Borders(xlEdgeTop).LineStyle = xlContinuous Target.Borders(xlEdgeRight).LineStyle = xlContinuous End Select End If End If Application.EnableEvents = True End Sub 

Answer 2

我强烈build议你更好地理解变体，范围，单元格和单元格的区别。 如果你这样做，你会写更好的代码。 例如，你声明c As Variant 。 但实际上，你希望c是一个范围的单元格。 然后， If c = 0 And Len(c) <> 0可以解决范围的默认属性（即Value属性），但是您已经忘记了它是一个范围。 因为接下来你把c的地址，并从中创build一个范围。 显然，具有相同地址的两个范围必须由两个不同名称的相同范围。 我已经对你的代码进行了sorting，并消除了逻辑不足的许多其他问题。

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range Dim Rng As Range Dim LinStyl As Long Dim Arrow As Long Dim Col As Long Set Rng = Range("C10:AA36,C44:AA68") If Intersect(Rng, Target) Is Nothing Then Exit Sub Application.EnableEvents = False For Each Cell In Target If Len(Cell.Value) Then LinStyl = xlNone Arrow = 0 Select Case Val(Cell.Value) Case 0 LinStyl = xlContinuous Col = vbBlack Case 1 Arrow = 112 Col = vbGreen Case 2 Arrow = 113 Col = vbRed End Select With Cell If Arrow Then .Font.Name = "Wingdings 3" Else ' use the font specified for cell A1 .Font.Name = Cells(1, 1).Font.Name End If .Font.Color = Col .Value = Chr(Arrow) .HorizontalAlignment = xlRight .Borders(xlDiagonalDown).LineStyle = LinStyl End With End If Next Cell Application.EnableEvents = True End Sub 

请记住， Target是发生更改的单元格。 如果粘贴数据，可以同时更改几个单元格。 如果更改发生在Range("C10:AA36,C44:AA68")的任何地方，将会处理已更改的单元格，但不是范围内的所有单元格均为您的代码。

现在代码工作。 它有一个逻辑，但它远非完美。 请从这里采取并进一步改进。