| 
    
     |  | Statisさん、レスありがとうございました。 
 Dim k As Integer, L As Integer, Asset1 As String,ID1 As String
 Dim j As Integer, Sheets1Count As Integer, r1 As Long
 Dim SheetName As Variant, ArrayCounter As Integer
 
 SheetName = Array("CASH", "FI", "EQ")
 Sheets1Count = Workbooks("Jul 2005.xls").Worksheets.Count
 r1 = Cells(Workbooks("Fund.xls") .Worksheets("Discrep").Rows.Count, "A").End(xlUp).Row
 
 For j = 7 To r1
 For k = j-1 To j
 Asset1 = Workbooks("Fund.xls") .Worksheets("Discrep").Range("A" & k).Value
 For L = 1 To Sheets1Count
 For ArrayCounter = 1 To UBound(SheetName)
 If Workbooks("Jul 2005.xls").Worksheets(L).Name = SheetName(ArrayCounter) And Not Workbooks("Jul 2005.xls").Worksheets(L).Cells.Find(Asset1) Is Nothing Then
 ID1 = Workbooks("Jul 2005.xls").Worksheets(L).Cells.Find(Asset1).Offset(, 2).Value
 Workbooks("Fund.xls") .Worksheets("Discrep").Range("Q" & k).Value = ID1
 Exit For
 End If
 Next ArrayCounter
 Next L
 (中略)
 Next k
 (中略)
 r1 = Cells(Workbooks("Fund.xls") .Worksheets("Discrep").Rows.Count, "A").End(xlUp).Row
 Next j
 
 で何とか、目標に近づきました。
 
 1番最後にr1 = Cells(Workbooks("Fund.xls") .Worksheets("Discrep").Rows.Count, "A").End(xlUp).Row
 と数えなおしているのは、(中略)の部分で、Cell(j, A)に空白セルを挿入する場合があり、A列の使用している行数が毎回変わるからです。
 For j = 7 To r1
 For k = j-1 To j
 と入れ子にしているのもそのためです。
 
 ただ、すごく時間がかかります。検索先をCellsととしているからでしょうか。
 
 Workbooks("Jul 2005.xls").Worksheets(L).Name = SheetName(ArrayCounter) And Not Workbooks("Jul 2005.xls").Worksheets(L).Cells.Find(Asset1) Is Nothing
 というひとつの条件を満たせば、
 
 For L = 1 To Sheets1Count
 For ArrayCounter = 1 To UBound(SheetName)
 の二つのループを同時に抜けられるようにしたいのですが、どうやってコードを書いたらよいのでしょうか。
 
 他にも時間を短縮する方法があったら教えてください。
 
 |  |