我實際上面臨一個問題。我必須使用 Excel 來構建資料庫，并且遇到了一些麻煩。
我將作業表用作表格，將列用作欄位。一些表與其他具有 ID 欄位的表相關，就像我們可以使用關系資料庫創建的那樣。
我的問題是我的一段代碼運行得很慢，占用了我高達 60% 的 CPU。
資料庫用戶需要在輸入時實時查看他們正在操作的表中是否存在重復值。
Private Sub UserForm_Initialize()
'Loading Form.
Load Me
'Initialisation of Filtered Data Sheet.
Dim wsData As Worksheet
Set wsData = Worksheets("DonneesFiltrees")
'Disable screen update so the user do not see sheet with data wrote on it.
Application.ScreenUpdating = False
'Initialize the sheet the user wants to use.
Set usingWs = Worksheets("Listes")
usingWs.Visible = xlSheetVisible
usingWs.Select
'Sends data to Filtered Data Sheet.
Call ModuleDonnees.TransferToFilterByName(usingWs, "Devises")
'Populate the userForm list from Filtered Data Sheet
Me.listExistants.ColumnCount = 1
Me.listExistants.RowSource = populateList(wsData, "A")
End Sub
不幸的是，我在用戶輸入的每個字母處執行所有這些代碼，可能它對于 excel 來說太重了，但這是我老板的要求......
Private Sub txtNom_Change()
'Initalize Filtered Data Sheet
Dim wsData As Worksheet
Dim FilteredRange As Range
Set wsData = Worksheets("DonneesFiltrees")
'Apply filter on Source Data Sheet. Sort of : Select * In 'myTable' Where Name Like 'UserRequest';
usingWs.ListObjects("Devises").DataBodyRange.AutoFilter Field:=1, Criteria1:="=*" & Me.txtNom.Value & "*", Operator:=xlAnd
'Get the Filtered Data Range
On Error Resume Next
Set FilteredRange = usingWs.ListObjects("Devises").DataBodyRange.SpecialCells(xlCellTypeVisible)
'If the filtered data range is empty, the data doesn't exist, we can write it in the DB.
If FilteredRange Is Nothing Then
wsData.ListObjects(1).DataBodyRange.Clear
isOk = True
Else
'If the filtered data range isn't empty refresh data by sending filtered data from source sheet
'to the filtered data sheet. So the user see datas matching what he's typing.
Call ModuleDonnees.TransferToFilterByName(usingWs, "Devises")
isOk = False
End If
End Sub
Private Sub btnAjout_Click()
Dim newRow As ListRow
'Clearing Filter
usingWs.ListObjects("Devises").AutoFilter.ShowAllData
'This Condition is used to Match if the data really exist
'Lets admit than the user wants to write Ira as a country
'Iraq and Iran exists and will be in the list of existing values but are not exactly the same
'in this case we should let the user write it.
If isOk = False Then
i = 0
Do While (i < Me.listExistants.ListCount - 1)
If Me.listExistants.List(i) = Me.txtNom.Value Then
isOk = False
Exit Do
Else
isOk = True
i = i 1
End If
Loop
End If
If isOk = True Then
'Asking for validation before he write the data.
Confirmation = MsgBox("Voulez-vous confirmer la saisie de données ?", 36, "Confirmation")
If Confirmation = vbNo Then
MsgBox "Saisie annulée"
Exit Sub
ElseIf Confirmation = vbYes Then
'Add row
Set newRow = usingWs.ListObjects("Devises").ListRows.Add
'Write the value
With newRow
.Range(1) = Me.txtNom.Value
End With
'Validation Message
MsgBox "La devise a bien été ajouté à la base de données"
'Closing Form
Unload Me
Else
'If is Ok still false it means that the data already exists in database so we block the user
MsgBox "Il semblerait que votre saisie existe déjà dans la base de données"
Unload Me
Exit Sub
End If
End Sub
有我的匯入資料方法，
'As I'm using tables I copy the header range and then body range and transform it to a table
Function TransferToFilterByName(ws As Worksheet, tableName As String)
Dim wsData As Worksheet
Set wsData = Worksheets("DonneesFiltrees")
Dim FilteredRange As Range
wsData.Cells.Clear
ws.Visible = xlSheetVisible
ws.Select
ws.ListObjects(tableName).HeaderRowRange.Copy Destination:=wsData.Range("A1")
ws.Select
Set FilteredRange = ws.ListObjects(tableName).DataBodyRange.SpecialCells(xlCellTypeVisible)
FilteredRange.Copy Destination:=wsData.Range("A2")
Call ConvertToTable
End Function
Function ConvertToTable()
Dim tbl As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("DonneesFiltrees")
Set tbl = ws.Range("A1").CurrentRegion
ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=tbl, xllistobjecthasheaders:=xlYes).Name = "DonneesFiltrees"
End Function
我的所有代碼都用于將資料添加到某些作業表，但正如我之前所說，它使用了我的 CPU 的 50% 到 60%，盡管資料量很少，但它的運行速度有點慢。
這僅僅是因為在 userForm txtBox_Change() 上執行它嗎？或者有沒有辦法優化它而不改變它。
任何幫助將不勝感激。
提前致謝。
uj5u.com熱心網友回復：
我承認我并沒有完全遵循您的所有邏輯，因為在過濾了您的Devises表并檢查了可見行之后，即使沒有任何行，它似乎也保持過濾狀態？我建議的一些重組（就我對您的代碼的理解而言）不會在txtNom_Change()中進行任何過濾- 而是只使用 WorksheetFunction 物件的 MATCH() 方法，因為它很高興處理通配符。然后，在TransferToFilterByName()程序中對您的Devises表進行實際過濾，這將始終是必要的。（基于 FunThomas 的評論，因為您已經了解 SQL，所以這個是一個關于如何在 Excel 中使用它/ADODB 的優秀播放串列）
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/465703.html