Question

我在Excel中使用VBA非常新。我想要完成的是这个。当用户输入长度为5时，则必须将5列标记为红色。然后，当用户输入宽度为6时，则必须将6行划线为红色。例如：

到目前为止我有这个代码：

在工作表更改中

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Target.Address = "$A$2") Then
    Call Draw2DTankl
  ElseIf (Target.Address = "$B$2") Then
    Call Draw2DTankw
  End If
End Sub

Draw2DTankl：

Sub Draw2DTankl()

  On Error Resume Next
  Cells(2, 4).Value = ""
  Dim x As Range
  Set x = Worksheets("Sheet1").Cells

  x.Borders.LineStyle = xNone

  Range("A1") = "Length"


  Dim Length As Integer


   Length = CInt(Cells(2, 1).Value)


   If (Length > 30) Then
    MsgBox "A length of a maximum 30 is allowed"
    Exit Sub
  End If
  If (Length < 0) Then
    MsgBox "Invalid length value entered"
    Exit Sub
  End If


   Dim Rws As Long, Rng As Range, r As Range
    If (Length > 0) Then
    Rws = 20
    Set Rng = Range(Cells(20, "H"), Cells(Rws, 8 + Length - 1))

    For Each r In Rng.Cells

            With r.Borders

                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3

            End With
    Next r
    End If

If (Err.Number <> 0) Then
    MsgBox Err.Description
End If

End Sub

Draw2DTankw：

Sub Draw2DTankw()

  On Error Resume Next
  Cells(2, 4).Value = ""
  Dim x As Range
  Set x = Worksheets("Sheet1").Cells

  x.Borders.LineStyle = xNone


  Range("B1") = "Width"


  Dim Width As Integer



   Width = CInt(Cells(2, 2).Value)


  If (Width > 30) Then
    MsgBox "A width of a maximum 30 is allowed"
    Exit Sub
  End If
  If (Width < 0) Then
    MsgBox "Invalid Width value entered"
    Exit Sub
  End If


     Dim Col As Long, Rng As Range, r As Range
    If (Width > 0) Then
    Col = 21
    Set Rng = Range(Cells(21, "H"), Cells(Col, 8 + Length - 1))

    For Each r In Rng.Cells

            With r.Borders

                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3

            End With
    Next r
    End If

If (Err.Number <> 0) Then
    MsgBox Err.Description
End If

End Sub

请帮帮我。我的代码不起作用。长度有效，但是当我改变宽度时它会刹车。

输入我的长度：

哪个是对的。但是如果我输入宽度为6，则会发生这种情况:(我的长度也消失了）

我为这篇长篇帖子道歉！

Answer 1

看起来在Draw2DTankw中你有上面声明的宽度，但在你使用长度的rng中

Dim Width As Integer Width = CInt（Cells（2,2）.Value）

设置Rng =范围（单元格（21，“H”），单元格（Col，8 +长度 - 1））

我修改了你的代码，通过扩展范围来包括宽度来绘制高度和宽度。这与我测试一起工作。

Private Sub Worksheet_Change(ByVal Target As Range)
  If (Target.Address = "$A$2") Or (Target.Address = "$B$2") Then
  DrawTable
  End If
End Sub

Sub DrawTable()

  On Error Resume Next
  Cells(2, 4).Value = ""
  Dim x As Range
  Set x = ActiveSheet.Cells

  x.Borders.LineStyle = xNone

  Range("A1") = "Length"


  Dim Length As Integer
   Length = CInt(Cells(2, 1).Value)
   'Combined Width sections
  Dim Width As Integer
   Width = CInt(Cells(2, 2).Value)

   If (Length > 30) Then
    MsgBox "A length of a maximum 30 is allowed"
    Exit Sub
    ElseIf (Width > 30) Then
    MsgBox "A width of a maximum 30 is allowed"
    Exit Sub
    ElseIf (Length < 0) Then
    MsgBox "Invalid length value entered"
    Exit Sub
    ElseIf (Width < 0) Then
    MsgBox "Invalid Width value entered"
    Exit Sub
  End If


   Dim Rws As Long, Rng As Range, r As Range
    If (Length > 0) Then
    Rws = 20
    'Added width to cells(rws)
    Set Rng = Range(Cells(20, "H"), Cells(Rws + Width - 1, 8 + Length - 1))

    For Each r In Rng.Cells

            With r.Borders

                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3

            End With
    Next r
    End If

If (Err.Number <> 0) Then
    MsgBox Err.Description
End If
End Sub

根据用户提供的宽度和高度绘制表格

1 个答案: