|    | 
     はじめまして。よろしくお願いします。 
 
既存コードのスピードアップのため、配列のコーディングに取組みだしました。 
セルからセルへの値の転記のイメージで、配列からセルへの値の転記を 
実施しようとしています。 
 
予め、セルの範囲わかっている場合の、配列から一気にセルに転記する例は、 
Webでいろいろ検索出来たのですが、配列ないの範囲指定してセルに一気に 
転記する例は見つける事が出来ませんでした。 
 
以下のKizonコードを作り直ししていますが、配列の範囲指定が出来るのか、 
方法もわからず悩んでいます。 
※LOOPでトライしましたが、既存コードの方がスピードが速かったので、 
 やはり、一気に転記する方法で実現したいと思っています。 
 
ご指導のほど、お願いいたします。 
 
 
【既存コード】------------------------------------------------------------ 
Sub kizon() 
 
Dim Ij(1) as Integer:Dim Maxrows as Long 
 
 Maxrows = Ws.Cells(Rows.count, 46).End(xlUp).Row 
 Ij(1) = 54 
 
 Do Until Ij(1) >= 142 
  Ws.Select 
  Ws.Range(Cells(4, Ij(1) + 1), Cells(Maxrows, Ij(1) + 1)).Select 
    Selection.Copy 
 
  Ws.Range(Cells(4, Ij(1)), Cells(Maxrows, Ij(1))).Select 
  Selection.PasteSpecial Paste:=xlPasteFormulas, 
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
  Ws.Range(Cells(4, Ij(1) + 1), Cells(Maxrows, Ij(1) + 1)) = 0 
  
  Ij(1) = Ij(1) + 4 
 Loop 
 
End sub 
 
 
【リメイク中のコード】---------------------------------------------------- 
Private Function Sheet2Array(BookName As String, SheetName As String) As Variant 
 
 Dim RowNum1 As Double 
 Dim ColNum1 As Double 
 
 With Workbooks(BookName).Sheets(SheetName) 
   RowNum1 = .UsedRange.Rows.count 
   ColNum1 = .UsedRange.Columns.count 
   Sheet2Array = .Range(.Cells(1, 1), .Cells(RowNum1, ColNum1)) 
 End With 
 
End Function 
--------------------------------------------------------------------------- 
 
Sub ReMake() 
 
Dim Ij(1) as Integer:Dim Maxrows as Long 
Dim DataBase() As Variant 
 
 Maxrows = Ws.Cells(Rows.count, 46).End(xlUp).Row 
 Ij(1) = 54 
 
 Do Until Ij(1) >= 142 
  Ws.Select 
  Ws.Range(Cells(4, Ij(1)), Cells(Maxrows, Ij(1))) = 'DataBase・・・ここが不明 
  Ws.Range(Cells(4, Ij(1) + 1), Cells(Maxrows, Ij(1) + 1)) = 0 
  
  Ij(1) = Ij(1) + 4 
 Loop 
 
End sub 
 | 
     
    
   |