我实际上正面临一个问题。我必须用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
这是我用于向某些表添加数据的所有代码，但正如我之前所说，这使用了大约50%到60%的CPU，尽管数据量很少，但运行速度很慢。
这仅仅是因为在userForm txtBox_Change()上执行它吗?或者有没有一种方法可以在不改变它的情况下优化它。
如有任何帮助，我将不胜感激。
提前感谢。
我承认我不完全遵循你的逻辑，过滤你的设计表后，并检查可见的行，它似乎保持过滤，即使没有任何?我建议(就我所理解的代码而言)不要在txtNom_Change()中进行任何过滤，而只是使用WorksheetFunction对象的MATCH()方法，因为它可以愉快地处理通配符。然后，在TransferToFilterByName()过程中对designs表进行实际的过滤，其中总是是必要的。(建立在FunThomas的评论，因为你已经知道SQL，这是一个关于如何在Excel中使用它/ADODB的优秀播放列表)