|
▼T-K さん:
>最後にデータをエクセルシートに処理する際に
>繰り返し処理にて展開してますが一括での感じがわかりません
それだと、速度改善にならないと思います。
dictionaryでも、一括で書き込まないと同じです。
Sub test2()
Dim fSh As Worksheet
Dim tSh As Worksheet
Dim dicX As Object
Dim dicY As Object
Dim tbl As Range
Dim i As Long, k As Long
Dim dt As Double
Dim com As String
Dim mX, mY
Dim w
Application.ScreenUpdating = False
Set dicX = CreateObject("Scripting.Dictionary")
Set dicY = CreateObject("Scripting.Dictionary")
Set fSh = Sheets("Sheet1")
Set tSh = Sheets("Sheet2")
fSh.Cells.Interior.ColorIndex = xlNone
Set tbl = tSh.Range("A1").CurrentRegion
w = tbl.Value
With fSh.Range("A1").CurrentRegion
For i = 2 To .Rows.Count
com = .Cells(i, "B").Value
If Not dicY.exists(com) Then
mY = Application.Match(com, tbl.Columns("B"), 0)
If IsError(mY) Then
.Rows(i).Interior.ColorIndex = 3
End If
dicY(com) = mY
End If
If IsNumeric(dicY(com)) Then
For k = 3 To .Columns.Count
dt = .Cells(1, k).Value2
If Not dicX.exists(dt) Then
mX = Application.Match(dt, tbl.Rows(1), 0)
If IsError(mX) Then
.Columns(k).Interior.ColorIndex = 3
End If
dicX(dt) = mX
End If
If IsNumeric(dicX(dt)) Then
w(dicY(com), dicX(dt)) = .Cells(i, k).Value
End If
Next
End If
Next
End With
tbl.Value = w
MsgBox "転記完了"
End Sub
|
|