Option Explicit
Const Scrbook As String = "転記元.xlsx"
Const Folder As String = "D:\goo\data"
Public Sub メモリ転記()
Dim t0, t1, t2, t3
Dim dict As Object
Dim sh1 As Worksheet '転記元ワークシート
Dim sh2 As Worksheet '転記先ワークシート
Dim maxrow1 As Long '転記元最大行番号 A列
Dim maxrow2 As Long '転記先最大行番号 F列
Dim row1 As Long '転記元
Dim row2 As Long '転記先
Dim key As Variant '転記元
Dim key2 As Variant '転記先
Dim Carr As Variant '転記元 C列配列
Dim Zarr As Variant '転記元 Z列配列
Dim Harr As Variant '転記元 H列配列
Dim Garr As Variant '転記元 G列配列
Dim Larr As Variant '転記元 L列配列
Dim Karr As Variant '転記元 K列配列
Dim DQarr As Variant '転記元 DQ列配列
Dim Tarr As Variant '転記元 T列配列
Dim Varr As Variant '転記元 V列配列
Dim no As Long 'no
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sh2 = Worksheets("Sheet1")
maxrow2 = sh2.Cells((Rows.Count), "F").End(xlUp).row
Set dict = CreateObject("Scripting.Dictionary")
t0 = Time
Workbooks.Open Filename:=Folder & "\" & Scrbook, ReadOnly:=True, UpdateLinks:=0
t1 = Time
Set sh1 = Worksheets("転記元")
maxrow1 = sh1.Cells((Rows.Count), "A").End(xlUp).row 'ID
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "A")
dict(key) = row1 - 2 + 1
Next
Call GetArray(sh1, 2, maxrow1, "C", Carr)
Call GetArray(sh1, 2, maxrow1, "Z", Zarr)
Call GetArray(sh1, 2, maxrow1, "H", Harr)
Call GetArray(sh1, 2, maxrow1, "G", Garr)
Call GetArray(sh1, 2, maxrow1, "L", Larr)
Call GetArray(sh1, 2, maxrow1, "K", Karr)
Call GetArray(sh1, 2, maxrow1, "DQ", DQarr)
Call GetArray(sh1, 2, maxrow1, "T", Tarr)
Call GetArray(sh1, 2, maxrow1, "V", Varr)
t2 = Time
For row2 = 4 To maxrow2
key2 = sh2.Cells(row2, "F").Value
If dict.exists(key2) = True And sh2.Cells(row2, "H") = "" Then
no = dict(key2)
sh2.Cells(row2, "E").Value = Carr(no, 1)
sh2.Cells(row2, "G").Value = Zarr(no, 1)
sh2.Cells(row2, "H").Value = Harr(no, 1)
sh2.Cells(row2, "I").Value = Garr(no, 1)
sh2.Cells(row2, "J").Value = Larr(no, 1)
sh2.Cells(row2, "K").Value = Karr(no, 1)
sh2.Cells(row2, "M").Value = DQarr(no, 1)
sh2.Cells(row2, "O").Value = Tarr(no, 1)
sh2.Cells(row2, "P").Value = Varr(no, 1)
End If
Next
t3 = Time
Workbooks(Scrbook).Close
Debug.Print "メモリ転記"
Debug.Print "Open", 86400 * (t1 - t0)
Debug.Print "GetIDs", 86400 * (t2 - t1)
Debug.Print "Sheet1", 86400 * (t3 - t2)
MsgBox ("完了")
End Sub
Private Sub GetArray(ByVal ws As Worksheet, ByVal srow As Long, ByVal erow As Long, ByVal col As String, ByRef arr As Variant)
Dim rg As String
rg = col & srow & ":" & col & erow
arr = ws.Range(rg).Value
End Sub
T3B0aW9uIEV4cGxpY2l0CkNvbnN0IFNjcmJvb2sgQXMgU3RyaW5nID0gIui7ouiomOWFgy54bHN4IgpDb25zdCBGb2xkZXIgQXMgU3RyaW5nID0gIkQ6XGdvb1xkYXRhIgoKUHVibGljIFN1YiDjg6Hjg6Ljg6rou6LoqJgoKQogICAgRGltIHQwLCB0MSwgdDIsIHQzCiAgICBEaW0gZGljdCBBcyBPYmplY3QKICAgIERpbSBzaDEgQXMgV29ya3NoZWV0ICAgICfou6LoqJjlhYPjg6/jg7zjgq/jgrfjg7zjg4gKICAgIERpbSBzaDIgQXMgV29ya3NoZWV0ICAgICfou6LoqJjlhYjjg6/jg7zjgq/jgrfjg7zjg4gKICAgIERpbSBtYXhyb3cxIEFzIExvbmcgICAgICfou6LoqJjlhYPmnIDlpKfooYznlarlj7fjgIBB5YiXCiAgICBEaW0gbWF4cm93MiBBcyBMb25nICAgICAn6Lui6KiY5YWI5pyA5aSn6KGM55Wq5Y+344CARuWIlwogICAgRGltIHJvdzEgQXMgTG9uZyAgICAgICAgJ+i7ouiomOWFgwogICAgRGltIHJvdzIgQXMgTG9uZyAgICAgICAgJ+i7ouiomOWFiAogICAgRGltIGtleSBBcyBWYXJpYW50ICAgICAgJ+i7ouiomOWFgwogICAgRGltIGtleTIgQXMgVmFyaWFudCAgICAgJ+i7ouiomOWFiAogICAgRGltIENhcnIgQXMgVmFyaWFudCAgICAgJ+i7ouiomOWFgyBD5YiX6YWN5YiXCiAgICBEaW0gWmFyciBBcyBWYXJpYW50ICAgICAn6Lui6KiY5YWDIFrliJfphY3liJcKICAgIERpbSBIYXJyIEFzIFZhcmlhbnQgICAgICfou6LoqJjlhYMgSOWIl+mFjeWIlwogICAgRGltIEdhcnIgQXMgVmFyaWFudCAgICAgJ+i7ouiomOWFgyBH5YiX6YWN5YiXCiAgICBEaW0gTGFyciBBcyBWYXJpYW50ICAgICAn6Lui6KiY5YWDIEzliJfphY3liJcKICAgIERpbSBLYXJyIEFzIFZhcmlhbnQgICAgICfou6LoqJjlhYMgS+WIl+mFjeWIlwogICAgRGltIERRYXJyIEFzIFZhcmlhbnQgICAgJ+i7ouiomOWFgyBEUeWIl+mFjeWIlwogICAgRGltIFRhcnIgQXMgVmFyaWFudCAgICAgJ+i7ouiomOWFgyBU5YiX6YWN5YiXCiAgICBEaW0gVmFyciBBcyBWYXJpYW50ICAgICAn6Lui6KiY5YWDIFbliJfphY3liJcKICAgIERpbSBubyBBcyBMb25nICAgICAgICAgICdubwogICAgQXBwbGljYXRpb24uU2NyZWVuVXBkYXRpbmcgPSBGYWxzZQogICAgQXBwbGljYXRpb24uQ2FsY3VsYXRpb24gPSB4bENhbGN1bGF0aW9uTWFudWFsCiAgICBTZXQgc2gyID0gV29ya3NoZWV0cygiU2hlZXQxIikKICAgIG1heHJvdzIgPSBzaDIuQ2VsbHMoKFJvd3MuQ291bnQpLCAiRiIpLkVuZCh4bFVwKS5yb3cKICAgIFNldCBkaWN0ID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpCiAgICAKICAgIHQwID0gVGltZQogICAgV29ya2Jvb2tzLk9wZW4gRmlsZW5hbWU6PUZvbGRlciAmICJcIiAmIFNjcmJvb2ssIFJlYWRPbmx5Oj1UcnVlLCBVcGRhdGVMaW5rczo9MAogICAgdDEgPSBUaW1lCiAgICBTZXQgc2gxID0gV29ya3NoZWV0cygi6Lui6KiY5YWDIikKICAgIG1heHJvdzEgPSBzaDEuQ2VsbHMoKFJvd3MuQ291bnQpLCAiQSIpLkVuZCh4bFVwKS5yb3cgICAgJ0lECiAgICBGb3Igcm93MSA9IDIgVG8gbWF4cm93MQogICAgICAgIGtleSA9IHNoMS5DZWxscyhyb3cxLCAiQSIpCiAgICAgICAgZGljdChrZXkpID0gcm93MSAtIDIgKyAxCiAgICBOZXh0CiAgICBDYWxsIEdldEFycmF5KHNoMSwgMiwgbWF4cm93MSwgIkMiLCBDYXJyKQogICAgQ2FsbCBHZXRBcnJheShzaDEsIDIsIG1heHJvdzEsICJaIiwgWmFycikKICAgIENhbGwgR2V0QXJyYXkoc2gxLCAyLCBtYXhyb3cxLCAiSCIsIEhhcnIpCiAgICBDYWxsIEdldEFycmF5KHNoMSwgMiwgbWF4cm93MSwgIkciLCBHYXJyKQogICAgQ2FsbCBHZXRBcnJheShzaDEsIDIsIG1heHJvdzEsICJMIiwgTGFycikKICAgIENhbGwgR2V0QXJyYXkoc2gxLCAyLCBtYXhyb3cxLCAiSyIsIEthcnIpCiAgICBDYWxsIEdldEFycmF5KHNoMSwgMiwgbWF4cm93MSwgIkRRIiwgRFFhcnIpCiAgICBDYWxsIEdldEFycmF5KHNoMSwgMiwgbWF4cm93MSwgIlQiLCBUYXJyKQogICAgQ2FsbCBHZXRBcnJheShzaDEsIDIsIG1heHJvdzEsICJWIiwgVmFycikKICAgIHQyID0gVGltZQogICAgRm9yIHJvdzIgPSA0IFRvIG1heHJvdzIKICAgICAgICBrZXkyID0gc2gyLkNlbGxzKHJvdzIsICJGIikuVmFsdWUKICAgICAgICBJZiBkaWN0LmV4aXN0cyhrZXkyKSA9IFRydWUgQW5kIHNoMi5DZWxscyhyb3cyLCAiSCIpID0gIiIgVGhlbgogICAgICAgICAgICBubyA9IGRpY3Qoa2V5MikKICAgICAgICAgICAgc2gyLkNlbGxzKHJvdzIsICJFIikuVmFsdWUgPSBDYXJyKG5vLCAxKQogICAgICAgICAgICBzaDIuQ2VsbHMocm93MiwgIkciKS5WYWx1ZSA9IFphcnIobm8sIDEpCiAgICAgICAgICAgIHNoMi5DZWxscyhyb3cyLCAiSCIpLlZhbHVlID0gSGFycihubywgMSkKICAgICAgICAgICAgc2gyLkNlbGxzKHJvdzIsICJJIikuVmFsdWUgPSBHYXJyKG5vLCAxKQogICAgICAgICAgICBzaDIuQ2VsbHMocm93MiwgIkoiKS5WYWx1ZSA9IExhcnIobm8sIDEpCiAgICAgICAgICAgIHNoMi5DZWxscyhyb3cyLCAiSyIpLlZhbHVlID0gS2FycihubywgMSkKICAgICAgICAgICAgc2gyLkNlbGxzKHJvdzIsICJNIikuVmFsdWUgPSBEUWFycihubywgMSkKICAgICAgICAgICAgc2gyLkNlbGxzKHJvdzIsICJPIikuVmFsdWUgPSBUYXJyKG5vLCAxKQogICAgICAgICAgICBzaDIuQ2VsbHMocm93MiwgIlAiKS5WYWx1ZSA9IFZhcnIobm8sIDEpCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICB0MyA9IFRpbWUKICAgIFdvcmtib29rcyhTY3Jib29rKS5DbG9zZQogICAgRGVidWcuUHJpbnQgIuODoeODouODqui7ouiomCIKICAgIERlYnVnLlByaW50ICJPcGVuIiwgODY0MDAgKiAodDEgLSB0MCkKICAgIERlYnVnLlByaW50ICJHZXRJRHMiLCA4NjQwMCAqICh0MiAtIHQxKQogICAgRGVidWcuUHJpbnQgIlNoZWV0MSIsIDg2NDAwICogKHQzIC0gdDIpCiAgICBNc2dCb3ggKCLlrozkuoYiKQpFbmQgU3ViClByaXZhdGUgU3ViIEdldEFycmF5KEJ5VmFsIHdzIEFzIFdvcmtzaGVldCwgQnlWYWwgc3JvdyBBcyBMb25nLCBCeVZhbCBlcm93IEFzIExvbmcsIEJ5VmFsIGNvbCBBcyBTdHJpbmcsIEJ5UmVmIGFyciBBcyBWYXJpYW50KQogICAgRGltIHJnIEFzIFN0cmluZwogICAgcmcgPSBjb2wgJiBzcm93ICYgIjoiICYgY29sICYgZXJvdwogICAgYXJyID0gd3MuUmFuZ2UocmcpLlZhbHVlCkVuZCBTdWIKCg==