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

我在Excel中使用VBA非常新。 我想要完成的是这个。 当用户input一个长度为5的字符时，则必须将5列显示为红色。 然后，当用户input6的宽度时，则必须将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 

请帮帮我。 我的代码不起作用。 长度工作，但是当我改变宽度刹车。

input我的长度绘制：

哪个是对的。 但是，如果我input6的宽度发生这种情况:(我的长度也消失）

我为这篇长文章道歉！

Answer 1

它看起来像在Draw2DTankw中，你已经在上面声明了宽度，但是在你使用的长度是rng

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

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

我修改了代码，通过扩展范围来包含宽度来绘制高度和宽度。 这与我testing它。

 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