Question

我花了整整3天的时间编写代码，而我根本不是程序员。

如果我在单元格中键入特定字符，则尝试动态设置单元格边框的格式，但不能用于公式或其他输入。

我有可以正常工作的代码。如果删除工作表更改事件和子参数，使用ActiveCell而不是Target并运行F8或F5，则运行。有时无法正确格式化单元格，但不会出错。

如果我使用工作表事件不起作用，则在键入时将不会自动起作用。它在标准模块中：

'super messy - mid draft + I have no idea what I'm doing

Option Explicit
Sub superset_exercise(ByVal Target As Range)
Dim cell, cellAbove, cellBelow, rangestart As Range
Dim Char, CharAbove, CharBelow As String
Dim strcell, strlengthA, strlengthB As Integer

'set cell reference to the one currently being typed in
Set cell = Target

'checks to see if it's an exercise list. Want only exercise lists formatted
If IsEmpty(Target) = True Then Exit Sub
strcell = InStr(1, cell, ")")
If strcell = 0 Or strcell = 1 Or strcell > 3 Then Exit Sub 'exit without formatting
Selection.Font.Bold = True

'compares active cell to cell above and below, match first letter
Set cellAbove = Target.Offset(-1, 0)    'ActiveCell instead of target?
Set cellBelow = Target.Offset(1, 0)

'Checks to see if cells above or below are empty
If cellAbove = "LIFT" Then If IsEmpty(cellBelow) = True Then GoTo TopEdge Else: GoTo CheckLetter


If IsEmpty(cellAbove) = True And cellAbove.Offset(0, 1) = "LIFT" Then
    If IsEmpty(cellBelow) = True Then GoTo TopEdge
    If IsEmpty(cellBelow) = False Then GoTo CheckLetter

ElseIf IsEmpty(cellAbove) = True Then Exit Sub
End If

CheckLetter:

    strlengthA = InStr(1, cellAbove, ")")
    strlengthB = InStr(1, cellBelow, ")")

        'set variables for letters in cells above and below the active cell
    CharAbove = Left(cellAbove, 1)
    CharBelow = Left(cellBelow, 1)
    Char = Left(cell, 1)

    If strcell = 2 Then GoTo OriginalFormat 'the only time ) at character 2 happens is a standalone exercise
    If strcell = 3 Then
        If strlengthA = strcell Then            'check if letter in cell above matches current cell letter for superset
            If CharAbove = Char Then            'if cell letters match, then check letter below. If all 3 match, format side edge superset
                If CharBelow = Char Or IsEmpty(cellBelow) = True Then GoTo SideEdge
                Else: GoTo BottomEdge
            End If
                                                'if cell letters don't match, format top edge
            If CharAbove <> Char Then GoTo TopEdge
         End If
    End If

    If strlengthA <> strcell And strlengthA = 2 Then GoTo TopEdge
    If strlengthA <> strcell And strlengthA = 0 And strlengthB = 0 Then GoTo TopEdge

        'see if letter in cell below matches for superset. If it does, format superset, if not diff. format

        If strlengthB = 0 Or strlengthB = 1 Or strlengthB > 3 Then Exit Sub
        If strlengthB = 2 Then GoTo BottomEdge
        If strlengthB = strcell Then
            If CharBelow = Char Then GoTo TopEdge
            If CharBelow <> Char Then GoTo BottomEdge
        End If
'...formatting labels below...

下面的工作表更改事件：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub 
Application.EnableEvents = False
Call superset_exercise(Target)
Application.EnableEvents = True
End Sub

我正在为运动员创建锻炼清单-每个清单都有特定的格式（参见图片）Exercise Table Format。该表的长度可以是任意数量的行。它们应该可以在电子表格内的任何位置创建-不同的运动项目有不同的图纸设计需求。

单元格内容将用于表的其他相关范围内的公式，格式相同。这些为父列表中的每个项目显示不同的计算属性。在这种情况下，应进行举重练习及其体积，吨位和强度。计算表通常相对于父表是水平或垂直的，并进行分组以便能够将其隐藏在视图之外。

我的代码显然也不格式化依赖范围，仅格式化我输入的区域。但是，这让我头疼。

对于我来说，最大的目标就是能够输入表格并自动设置其他表格的格式-与许多运动员一起节省大量时间。现在，我只需要一次格式化1张表即可。

Answer 1

我不太了解您的目标，但我可以给您一些建议，以继续进行下去：

尝试构造代码以避免GoTo。重复/可重复使用的代码应放在子代码中。
IsEmpty()返回布尔值。 If IsEmpty(cellAbove) = True Then与If IsEmpty(cellAbove) Then等效。

Worksheet_SelectionChange在每个光标移动时触发。我将检查活动单元格是否在要处理的范围内，如下所示：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub 
     Dim WorkRange as Range
     Set WorkRange = Range("B4:E9")
     If Application.Intersect(Target, WorkRange) Is Nothing Then Exit Sub  ' out of range
     ....

+1。不要放弃。 3天整天都无法准备第一个可行的宏：）

如何动态格式化单元格边框作为用户类型？

1 个答案: