通過可視細胞循環爲Excel訪問插入

我有一個項目，我在哪裏我的團隊使用Excel前端操縱這反過來又更新訪問後端數據庫來保存數據庫中的數據的工作。（有很好的理由）通過可視細胞循環爲Excel訪問插入

當前版本的工作原理是，如果用戶在細胞變化的數據，並希望他們更新彰顯細胞（S）和命中更新按鈕數據庫。（這變得煩人做多個更新）。所以我開始使用worksheet_changed功能。

爲了使worksheet_changed功能起作用，用戶必須關閉「更新」細胞的移動，以便Excel中注意到的改變和更新代碼。（在我的情況下，在數據輸入後按下Enter或向下箭頭）。我已經得到了這個工作，使用偏移屬性來查看上面的行，並將該行輸入到數據庫 - 但是 - 當電子表格被過濾，因爲它總是...如果上面的行恰好被隱藏它將更新該行實際上我需要可見單元更新....所以我卡住 - 下面是用於更新數據庫的代碼的一小塊。

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 "

任何幫助是極大的讚賞 - 謝謝你

來源

2014-10-06 Ethan V

'爲了使worksheet_changed功能起作用，用戶必須關閉「更新」細胞的移動，以便爲前cel注意到更改並更新代碼。「爲什麼？這不是必需的。您可以使用'Intersect'檢查一個特定的細胞被更新或不... – 2014-10-06 16:53:27

的'一個例子Intersect'是'如果沒有相交（目標，行（2））是沒有什麼Then'這將檢查是否改變發生在第2行。將row rumber更改爲相關行。此外，因爲您正在使用'Worksheet_Change'，我建議您閱讀[THIS]（http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs/13861640#13861640）鏈接。 – 2014-10-06 16:59:33

在此事件中，目標不是當前單元格，而是已更改的單元格。這裏不需要偏移量。 – 2014-10-06 16:59:48

Target.address

這應該引用改變的單元格的單元格地址，所以除非你改變一個隱藏單元格的隱藏單元格不應該被引用

如果你只需要行，你應該能夠做到Target.Row

來源

2014-10-06 18:55:00 Tbaker

謝謝Tbizzness！這實際上使我找到了解決辦法。我在Selection.Offset（-1,0）.Rows中爲每個C更改爲每個C在目標中，它現在工作得很漂亮。感謝所有的幫助！ – 2014-10-06 19:52:03

通過可視細胞循環爲Excel訪問插入

回答

相關問題