別の手法を使用してこのコードを高速化できるかどうか疑問に思っていました。コードはそれほど長くはかかりませんが、何かがどれだけ速く動作するかが通常求められていることを見て、速度を上げるために何かできることがないか興味がありました. このコードは単純に、すべての列をテンプレート テーブルに対してチェックして、値が一致するかどうかを確認するために使用されます。一致しない場合は、パーツに関する情報と、正しくない値と正しい値を示すレポートが作成されます。
Option Explicit
'Check values of table against template table
Sub checkTemplate(shnam1 As Worksheet, shnam2 As Worksheet, shnam3 As Worksheet)
'Initalizes integers that will be used
Dim rwIndex As Long '"Item Attributes" row index
Dim colIndex As Long '"Item Attributes" column index
Dim rowEnd As Long 'Last row in "Item Attributes"
Dim colEnd As Long 'Last column in "Item Attributes"
Dim tempIndex As Integer
Dim resRow As Long 'Current row in "Report" to paste
Dim resCol As Long 'Current column in "Report" to paste
Dim temp1 As String
Dim temp2 As String
'Gets bounds for "Item Attributes" table
rowEnd = shnam1.Cells(Application.Rows.Count, 1).End(xlUp).Row
colEnd = shnam1.Cells(1, Application.Columns.Count).End(xlToLeft).Column
'Report Heading
shnam3.Cells(1, 1).Value = "Oracle Part Number"
shnam3.Cells(1, 2).Value = "Description"
shnam3.Cells(1, 3).Value = "Attribute Name"
shnam3.Cells(1, 4).Value = "Incorrect Value"
shnam3.Cells(1, 5).Value = "Correct Value"
resRow = 2 'Set row for Results
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'From 2nd row to last row
For rwIndex = 2 To rowEnd
tempIndex = 3 'Template table index
resCol = 1 'Set column for results
temp1 = shnam1.Cells(rwIndex, 1)
temp2 = shnam1.Cells(rwIndex, 2)
'From 3rd column to last column
For colIndex = 3 To colEnd
'Compare selection in data to template table
If (shnam1.Cells(rwIndex, colIndex).Value) <> (shnam2.Cells(tempIndex, 1).Value) Then
shnam3.Cells(resRow, resCol) = temp1
shnam3.Cells(resRow, resCol + 1) = temp2
'Copy attribute name
shnam2.Cells(tempIndex, 2).Copy shnam3.Cells(resRow, resCol + 2)
'Copy incorrect attribute value
shnam1.Cells(rwIndex, colIndex).Copy shnam3.Cells(resRow, resCol + 3)
'Copy correct attribute value
shnam2.Cells(tempIndex, 1).Copy shnam3.Cells(resRow, resCol + 4)
resRow = resRow + 1 'Move down a row in the "Report" table
End If
tempIndex = tempIndex + 1 'Increment through template table
Next colIndex
Next rwIndex
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub