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!!!!"

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

2 个答案: