单元格上的Excel自动输入三角形

时间:2017-07-29 02:37:02

标签: excel vba excel-vba

这是我拥有的代码,当我输入0时,它会完美地工作,它会为我输入的每个单元格创建一条对角线0

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

我在为我添加的每个单元格添加一个三角形形状的选项时遇到问题,当我输入1个直角三角形然后2个为倒三角形时,我添加了这个选项

2 个答案:

答案 0 :(得分:0)

关于您的代码的一些意见/建议:

  • 由于您使用的是Worksheet_Change事件。您可以充分利用定义为Target的{​​{1}}对象,并且〜Range。因此,代码中ActiveCelladdr = c.Address的每个位置都可以替换为Range(addr)
  • 我已将Target替换为If,这样您将来可以轻松添加更多形状。

<强> 代码

Select Case

答案 1 :(得分:0)

我敦促您更好地理解变体,范围,细胞和该细胞的价值之间的差异。如果你这样做,你会写出更好的代码。例如,您声明c As Variant。但实际上你希望c成为一个范围的单元格。然后,使用If c = 0 And Len(c) <> 0解决范围的默认属性(Value属性),但您已经忘记它是一个范围。因为接下来你取c的地址并从中创建一个范围。显然,具有相同地址的两个范围必须是两个不同名称的相同范围。我已经对你的代码进行了整理,并消除了许多其他逻辑不足的点。

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")中的任何位置,则会更改已更改的单元格,但不会处理该范围内的所有单元格。

现在代码有效了。它有一个逻辑,但它远非完美。请从这里拿走它并进一步改进。