VBA单元格的设置值不会更改未保护工作表中的单元格内容

Question

我在Excel工作表中有以下宏-该宏检索由他们的医院编号标识的患者，并将姓氏放在一栏中，这很好用。

我现在需要在工作表中插入更多数据，但是当出现姓氏时，其他数据则没有。

我写相同的单元格，写到左边的单元格没有问题，但是当我尝试写右边的列时，什么也没发生。

工作表不受保护，字体和单元格背景不是白色的情况并非如此。 有任何想法吗？

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim Mrn As String

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed. 
    Set KeyCells = Range("C10:C29")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        Set cn = New ADODB.Connection
        Mrn = Target.Text

        If Mrn = "" Then
            Target.Offset(0, 1).Value = ""
        Else
            cn.ConnectionString = "MyConnectionString"
            cn.Open
            Set rs = cn.Execute("Select nhs_surname From nhs_patient_s Where UPPER(nhs_patientid) = '" + UCase(Mrn) + "'")

            If rs.EOF Then
                Target.Offset(0, 1).Value = "UNKNOWN"
            Else
                Do While Not rs.EOF
                    Dim surname As String
                    surname = rs("nhs_surname")
                    Target.Offset(0, 1).Value = surname
                    Target.Offset(, 3).Value = "Now here!!!!"
                    rs.MoveNext
                Loop
            End If
        End If
    End If
End Sub

Answer 1

在循环中，您要将每个姓氏放在同一列中，使用Range对象将其移动：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim Mrn As String
    Dim RgToFill As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Me.Range("C10:C29")
    Set RgToFill = Target.Offset(0, 1)

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        Set cn = New ADODB.Connection
        Mrn = Target.Text

        If Mrn = vbNullString Then
            RgToFill.Value = vbNullString
        Else
            cn.ConnectionString = "MyConnectionString"
            cn.Open
            Set rs = cn.Execute("Select nhs_surname From nhs_patient_s Where UPPER(nhs_patientid) = '" + UCase(Mrn) + "'")

            If rs.EOF Then
                RgToFill.Value = "UNKNOWN"
            Else
                Do While Not rs.EOF
                    Dim surname As String
                    surname = rs("nhs_surname")
                    RgToFill.Value = surname
                    '''Move the range to fill to the next column
                    Set RgToFill = RgToFill.Offset(0, 1)
                    rs.MoveNext
                Loop
            End If
        End If
    End If
End Sub

Answer 2

原来，姓氏所在的列是一个合并的单元格，这影响了“出库日期”列的偏移量。

所以解决方案是简单地使用数字6而不是3

Target.Offset(, 6).Value = "Now here!!!!"