代碼 實作功能，根據第一張sheet中客戶編號資料從另一個sheet中匹配到客戶詳細資訊后，把客戶資訊提取復制到第一個sheet中客戶編號后，這個程序速度非常慢，不知道哪里有問題
Private Sub cbAddCIS_Click()
Dim pvtTable As PivotTable
Dim oListObj As ListObject, oLO As ListObject
Dim f_rng As Range
Dim oNewRow As ListRow
Dim f_rowno As Long, f_colno As Long, t_colno As Long, r_pos As Long,
c_pos As Long
Dim lookup_value As String, lookup_col_name As String, result_col_name As
String
Dim found As Boolean
On Error Resume Next
Set pvtTable = ActiveSheet.PivotTables("客戶資產匯總表")
Set f_rng = pvtTable.RowRange
Set oListObj = Worksheets("客戶資產匯總").ListObjects("附加客戶資訊")
Set oLO = Worksheets("客戶資訊").ListObjects("客戶資訊表")
Call cbDelCIS_Click '先清除附加的客戶資訊
For f_rowno = 2 To f_rng.Rows.Count - 1 '處理每個行資料（去除標題行和匯總
行）
'插入一空行
Set oNewRow = oListObj.ListRows.Add
'用非空的查找要素（客戶號、身份證或姓名）去查找客戶資訊
found = False
For f_colno = 1 To f_rng.Columns.Count
lookup_value = f_rng.Cells(f_rowno, f_colno)
lookup_col_name = f_rng.Cells(1, f_colno)
If (lookup_value <> "" And lookup_value <> "(空白)") Then
r_pos = 0
r_pos = WorksheetFunction.Match(lookup_value, oLO.ListColumns
(lookup_col_name).DataBodyRange, 0)
If r_pos > 0 Then
found = True
Exit For
End If
End If
Next
If found Then '找到的話，逐一添加客戶資訊各要素
For t_colno = 1 To oListObj.ListColumns.Count
result_col_name = oListObj.ListColumns(t_colno).Name
c_pos = 0
c_pos = WorksheetFunction.Match(result_col_name,
oLO.HeaderRowRange, 0)
If c_pos > 0 Then
oNewRow.Range.Cells(1, t_colno) = oLO.DataBodyRange.Cells(r_pos,
c_pos)
End If
Next
End If
Next
End Sub
Private Sub cbDelCIS_Click()
Dim rng As Range
Set rng = Worksheets("客戶資產匯總").ListObjects("附加客戶資訊
").DataBodyRange
If rng Is Nothing Then
Exit Sub
End If
rng.Delete
End Sub
Private Sub cbrefresh_Click()
Dim pvtTable As PivotTable
Set pvtTable = ActiveSheet.PivotTables("客戶資產匯總表")
pvtTable.RefreshTable
If Worksheets("客戶資產匯總").ListObjects("附加客戶資訊").DataBodyRange
Is Nothing Then
Exit Sub
End If
'Call cbAddCIS_Click
End Sub
uj5u.com熱心網友回復：
ScreenUpdating 屬性
請參閱 應用于 示例 特性
如果螢屏更新功能是打開的，則該值為 True。Boolean 型別，可讀寫。
說明
關閉螢屏更新可加快宏的執行速度。這樣將看不到宏的執行程序，但宏的執行速度加快了。
當宏結束運行后，請記住將 ScreenUpdating 屬性設回到 True。
示例
本示例演示將螢屏更新關閉以后，系統如何加快代碼的執行速度。本示例隔列隱藏 Sheet1 上的列，并保存其執行時間。第一次，示例隱藏列時，螢屏更新是打開的；第二次執行時，螢屏更新是關閉的。運行本示例時，可比較資訊框中顯示的兩次執行時間。
Dim elapsedTime(2)
Application.ScreenUpdating = True
For i = 1 To 2
If i = 2 Then Application.ScreenUpdating = False
startTime = Time
Worksheets("Sheet1").Activate
For Each c In ActiveSheet.Columns
If c.Column Mod 2 = 0 Then
c.Hidden = True
End If
Next c
stopTime = Time
elapsedTime(i) = (stopTime - startTime) * 24 * 60 * 60
Next i
Application.ScreenUpdating = True
MsgBox "Elapsed time, screen updating on: " & elapsedTime(1) & _
" sec." & Chr(13) & _
"Elapsed time, screen updating off: " & elapsedTime(2) & _
" sec."
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/150546.html
標籤：VBA
上一篇：【跪求指點】VB中是否支持用SslStream.write發送資訊？
下一篇：vb做tcp助手時進制轉換的問題