当单元格仍在调整大小范围内时，保持数据的文本更改 [英] Keep text changes of data when cell is still within resize range

问题描述

我有一个VBA宏，它根据范围内特定单元格的用户输入来设置单元格的值.
但是，如果我向更新的单元格中添加文本，则如果更改用户值，它将擦除我的其他文本.

I have a VBA Macro that is setting the values of cells based on user input from specific cells in range.
However if I add text to the cell that was updated, if I change the user value it wipes my additional text.

例如:

我将B5设置为2，从而用以下文本值填充D5和E5:

I set B5 as 2, which populates D5 and E5 with the following text values:

• 课程名称:
• 不.受影响的幻灯片:
• 不.受影响的活动数量:

如果我用单元格等中的其他文本更新D5，则课程名称:abc，并将B5的值更新为1.D5仍在该范围内，但是它将删除我刚刚输入的其他文本.

If I update the D5 with additional text in the cell etc. Course Name: abc, and update the value of B5 to 1. D5 is still within the range, but it deletes the additional text I just entered.

如何设置它，以使在我减小或增大B5的值时，如果文本值已被编辑，它不会重置?

How can I set it so that it doesn't reset the text values if they have been edited when I reduce or increase the value of B5?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge <> 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("B5:B50")) Is Nothing Then
        Dim rw As Long
        rw = Target.Row

        Dim txt As String
        txt = "• Course Name:" & vbNewLine & _
              "• No. Of Slides Affected:" & vbNewLine & _
              "• No. of Activities Affected:"

        Select Case Target.Value
            Case 1 To 5
                Me.Range("D" & rw).Resize(, Target.Value).Value = txt
            Case Else
                Me.Range("D" & rw & ":H" & rw).Value = ""
        End Select
    End If

End Sub

推荐答案

类似以下内容:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const NUM_COLS As Long = 5
    Const TXT = "• Course Name:" & vbNewLine & _
              "• No. Of Slides Affected:" & vbNewLine & _
              "• No. of Activities Affected:"

    Dim rng As Range, i As Long, v

    If Target.CountLarge <> 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("B5:B50")) Is Nothing Then

        Set rng = Target.Offset(0, 2).Resize(1, NUM_COLS) 'range to check
        v = Target.Value

        If IsNumeric(v) And v >= 1 And v <= NUM_COLS Then
            For i = 1 To rng.Cells.Count
                With rng.Cells(i)
                    If i <= v Then
                        'Populate if not already populated
                        If .Value = "" Then .Value = TXT
                    Else
                        'Clear any existing value
                        .Value = ""
                    End If
                End With
            Next i
        Else
            rng.Value = "" 'clear any existing content
        End If

    End If

End Sub

这篇关于当单元格仍在调整大小范围内时，保持数据的文本更改的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！