循环遍历可见单元格以供 excel 访问插入

Question

我正在处理一个项目，我的团队使用 excel 前端来操作数据，从而更新访问数据库后端以保存数据库。 （这是有充分理由的）

如果用户更改单元格中的数据并想要更新数据库，则当前版本的工作原理是突出显示单元格并点击更新按钮。 （这变得烦人进行多次更新）。所以我开始玩 worksheet_changed 函数。

为了使 worksheet_changed 函数起作用，用户必须离开“更新”单元格，以便 excel 注意到更改并更新代码。 （在我的情况下，在数据输入后按回车键或向下箭头）。我已经使用 offset 属性来查看上面的行并将该行输入到数据库中 - 但是 - 当电子表格像往常一样被过滤时......如果上面的行恰好被隐藏，它将更新实际上我需要更新可见单元格时的那一行......所以我被卡住了 - 下面是用于更新数据库的一小部分代码。

Private Sub Worksheet_Change(ByVal Target As Range)

Refreshbuttons

Dim KeyCells As Range
Dim aCell As Range

Const TARGET_DB = "MKT DB1.accdb"

Dim VErrors(4) As String
VErrors(0) = "Y"
VErrors(1) = "YES"
VErrors(2) = "1"
VErrors(3) = "TRUE"

Dim NVErrors(5) As String
NVErrors(0) = "N"
NVErrors(1) = "NO"
NVErrors(2) = ""
NVErrors(3) = "0"
NVErrors(4) = "FALSE"

Set srch = Range("A4:Z4").Find("PROJECTID", , xlValues, xlWhole)
PRO = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("PROJECTDES", , xlValues, xlWhole)
PD = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("ECAT", , xlValues, xlWhole)
EC = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("SALEMODEL", , xlValues, xlWhole)
SM = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("MKDBROSOURCE", , xlValues, xlWhole)
MDR = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("SOLREVIEWED", , xlValues, xlWhole)
SRD = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("DBSUPPORTEDDUEDATE", , xlValues, xlWhole)
DSDD = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("CATEGORY", , xlValues, xlWhole)
CT = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("COMPLETE", , xlValues, xlWhole)
CMP = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("STYLECOUNT", , xlValues, xlWhole)
SC = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("ECATREADY", , xlValues, xlWhole)
ECR = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("ESTHRS", , xlValues, xlWhole)
EST = Chr(srch.Column + 64)
Set srch = Range("A4:Z4").Find("ACTUALHRS", , xlValues, xlWhole)
AH = Chr(srch.Column + 64)



 Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB

With cnn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Open MyConn
End With

projectCount = 0

**For Each C In Selection.Offset(-1,0).Rows
    tmp = C.Address**  // THIS IS WHERE MY ISSUE IS - IT LOOKS TO THE ROW ABOVE AND NOT THE  VISIBLE ROW

    ChangeFields = ""
    ChangeValuesOld = ""
    ChangeValuesNew = ""

If Range("A" & C.Row).EntireRow.Hidden = False Then
        'create the recordset
        Set rst = New ADODB.Recordset
        rst.CursorLocation = adUseServer

        'On Error GoTo Err1:
        strSQL = "SELECT * FROM Projects WHERE Projectid = " & Range(PRO & C.Row).Value & ""

        rst.Open Source:=strSQL, _
                ActiveConnection:=cnn
        If rst.EOF = False Then
            'Start = GetTickCount()

            If rst("Projectid") <> Range(PRO & C.Row).Value Or (IsNull(rst("Projectid")) And Range(PRO & C.Row).Value <> "") Then
                If IsNull(rst("projectid")) Then
                    ChangeValuesOld = ChangeValuesOld & "NULL "
                Else
                    ChangeValuesOld = ChangeValuesOld & rst("projectid") & " "
                End If

                If IsEmpty(Range(PRO & C.Row).Value) Then
                    ChangeValuesNew = ChangeValuesNew & "NULL "
                Else
                    ChangeValuesNew = ChangeValuesNew & Range(PRO & C.Row).Value & " "
                End If

                ChangeFields = ChangeFields & "PROJECTID "

            End If
             If rst("ProjectDes") <> Range(PD & C.Row).Value Or (IsNull(rst("ProjectDes")) And Range(PD & C.Row).Value <> "") Then
                If IsNull(rst("ProjectDes")) Then
                    ChangeValuesOld = ChangeValuesOld & "NULL "
                Else
                    ChangeValuesOld = ChangeValuesOld & rst("ProjectDes") & " "
                End If

                If IsEmpty(Range(PD & C.Row).Value) Then
                    ChangeValuesNew = ChangeValuesNew & "NULL "
                Else
                    ChangeValuesNew = ChangeValuesNew & Range(PD & C.Row).Value & " "
                End If

                ChangeFields = ChangeFields & "ProjectDes "
End If
             If rst("ECAT") <> Range(EC & C.Row).Value Or (IsNull(rst("ECAT")) And Range(EC & C.Row).Value <> "") Then
                If IsNull(rst("ECAT")) Then
                    ChangeValuesOld = ChangeValuesOld & "NULL "
                Else
                    ChangeValuesOld = ChangeValuesOld & rst("ECAT") & " "
                End If

                If IsEmpty(Range(EC & C.Row).Value) Then
                    ChangeValuesNew = ChangeValuesNew & "NULL "
                Else
                    ChangeValuesNew = ChangeValuesNew & Range(EC & C.Row).Value & " "
                End If

                ChangeFields = ChangeFields & "ECAT "

非常感谢任何帮助 - 谢谢

Answer 1

Target.address

这应该引用已更改单元格的单元格地址，因此除非您更改隐藏单元格，否则不应引用隐藏单元格

如果您只需要该行，您应该能够执行 Target.Row