Question

我正在开发一个项目，我的团队使用excel前端操作数据，然后更新数据库后端以保存数据库。（有很好的理由）

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

为了使workheet_changed函数起作用，用户必须离开'updated'单元格，以便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

循环通过可见细胞excel访问插入

1 个答案: