VBAセルの設定値が保護されていないシートのセル内容を変更しない

Question

Excelシートに次のマクロがあります。病院番号で識別された患者を取得して1つの列に姓を入れても問題ありません。

これで、シートにさらにデータを挿入する必要がありますが、姓が表示されている間は、他のデータは表示されません。

私は同じセル、左のセルに書き込むことに問題はありませんが、右の列に書き込んでみると何も起こりません。

シートは保護されていません。フォントとセルの背景が白い場合はありません。何か案は？あなたのループで

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

それは姓が置かれていた列だったことが判明Discharge Date列のオフセットに影響を与えました。 VBAのためではありませんタグ：

だから解決策は、[マクロタグ]を使用しないでください、むしろところで3

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

Answer 2

、あなたはそれを移動するには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