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

原来，这里姓正在把柱子是合并单元格，这影响了“排出日期”列的偏移量。

因此，解决办法是简单地用数字6，而不是3

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

Answer 2

随着你的循环，你把每一个姓氏在同一列，使用范围对象来移动它：

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