こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBA; 複数のループ処理

↓のようなコードがあります。
Dim i As Long, MaxRow1 As Long, MaxRow2 As Long
MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To MaxRow1
Worksheets("Sheet1").Cells(i, 1).Value = i
.
Next i

For i = 1 To MaxRow2
Worksheets("Sheet2").Cells(i, 1).Value = i
.
Next i

これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。
同様の処理をシート1、シート2で実施しているので纏めて記述したいです。
シート1、シート2に対する処理をサブルーチンにする方法しかありませんか?
どなたかお願いします。

If MaxRow1 >= MaxRow2 Then
For i = 1 To MaxRow1
Else
For i = 1 To MaxRow2
End If

Worksheets("Sheet1").Cells(i, 1).Value = i
Worksheets("Sheet2").Cells(i, 1).Value = i
.
Next i

投稿日時 - 2016-11-02 12:28:24

QNo.9250584

困ってます

質問者が選んだベストアンサー

#2 & #4 & #5です。
(1)
Call proc1(i, a, AA())
です。
Call proc1(i, a)と書いたのはコピペしたから間違っています。
(2)
最大行数はMaxRow1で決めています。正しく設定すれば異様に増えることはありません。
(3)
最終行がすべての列で#N/Aになるのは
ReDim AA(MaxRow1,MaxRow1)
と書いていて
ReDim AA(1 To MaxRow1,1 To MaxRow1)
としていないからではないですか?

投稿日時 - 2016-11-04 22:26:24

お礼

実際は2行目からデータを取得しています。
#N/Aが表示されていたのは、最大行数の次の行です。
↓で解決しました。
Worksheets("Sheet1").Range("A1").Resize(MaxRow1 - 1,MaxRow1) = AA
ありがとうございました。

投稿日時 - 2016-11-07 10:41:10

ANo.6

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.5

#2 & #4です。
#4のお礼に書かれているような状況だと
Sub proc1(ByVal i As Long, ByVal a As Long,AA() as Variant)
AA(i, a) = i
End Sub
のように引数にして引き渡すのがいいですね。
そしてこの場合にAAは呼び出す方のルーチンで定義します。配列の大きさは行方向はMaxRow1で,コードを見る限りでは列方向もMaxRow1ですね。
ReDim AA(1 To MaxRow1,1 To MaxRow1)
a=0 'と初期値を書いたほうがいいよ
For i = 1 To MaxRow1
a = a + 1
Call proc1(i, a)
Next i
Worksheets("Sheet1").Range("A1").Resize(MaxRow1,MaxRow1) = AA
なお,この場合にAAはMaxRow1 * MaxRow1の正方形の領域を上書きしてしまうのだが,実際には対角線のところしか値が設定されていません。もともと非対角のところに値があって,それには触らないことにしているのなら,ちょっと余分な作業が必要になります。

ところでproc1とproc2はやっている処理は同じなのだろうか?もしそうなら
Sub proc(ByVal i As Long, ByVal a As Long,AA() as Variant,ByVal MaxRow As Long)
のようにまとめることが出来るよね。

投稿日時 - 2016-11-04 11:40:10

補足

ありがとうございます。
配列を使用して、Sheet1、Sheet2に値がセットできました。
度々、申し訳ございませんが質問させてください。

1.
この例では、↓コール関数ですね?
Call proc1(i, a, AA())

2.
デバッカーで見るとセットされた値ですが、最大行数がブランクを含めて異様に増えています。
これを正しくセットされた行数分にしたいのですが、対策はございますか?

投稿日時 - 2016-11-04 20:31:54

お礼

何度も申し訳ございません。
配列を使用して、Sheet1、Sheet2にセットされた最終行はすべての列で#N/Aが表示されています。
どのような対策をすれば良いでしょうか?

投稿日時 - 2016-11-04 21:41:56

ANo.4

#2です。
ここで速度向上のためにやっているのはセルに対するアクセスを極力減らすことです。
例えば
Worksheets("Sheet1").Cells(i, a).Value = i
をループの中で何度も実行していますが,これを
AA(i, a) = i
と言うように配列に保存しておき,どこかのタイミングで,例えば
Worksheets("Sheet1").Range("A1").Resize(RowSize,ColumnSize) = AA
のように一気に書き出します。

投稿日時 - 2016-11-03 16:44:43

補足

大変申し訳ございませんが、サンプルをいただけないでしょうか?

投稿日時 - 2016-11-03 18:11:09

お礼

教えてください。
↓の例で、サブルーチンで保存した配列をどのよにして、本体の処理にもってくれば良いですか?

Sub test()

Dim i As Long, a As Long, b As Long, MaxRow1 As Long, MaxRow2 As Long
MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
ReDim AA'?

For i = 1 To MaxRow1
a = a + 1
Call proc1(i, a)
.
Next i
Worksheets("Sheet1").Range("A1").Resize(MaxRow1) = AA'サブルーチンで保存した配列をどのよにして、本体のtest()にもってくれば良いですか?,

For i = 1 To MaxRow2
b = b + 1
Call proc2(i, b)
.
Next i
Worksheets("Sheet2").Range("A1").Resize(MaxRow1) = AA'サブルーチンで保存した配列をどのよにして、本体のtest()にもってくれば良いですか?,

End Sub

Sub proc1(ByVal i As Long, ByVal a As Long)
MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
ReDim AA(1 To MaxRow1, 1 To 1)

AA(i, a) = i


End Sub

Sub proc2(ByVal i As Long, ByVal a As Long)
MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
ReDim AA(1 To MaxRow2, 1 To 1)

AA(i, a) = i


End Sub

投稿日時 - 2016-11-04 02:47:35

ANo.3

ループは回さない方が早いです。
やりたいことはこんな感じでしょうか?

Sub test()
  MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
  If MaxRow1 < MaxRow2 Then MaxRow1 = MaxxRow2

  With Worksheets("Sheet1").Range("A1:A" & MaxRow1)
    .Formula = "=Row()"
    .Value = .Value
  End With

  With Worksheets("Sheet2").Range("A1:A" & MaxRow1)
    .Formula = "=Row()"
    .Value = .Value
  End With
End Sub

投稿日時 - 2016-11-02 15:17:40

ANo.2

「パフォーマンスを良くしたいと思います」というのと「サブルーチンにする」のは対して関係がないでしょう。
本当にパフォーマンスを良くしたいのなら,例えば
MaxRow = WorksheetFunction.Max(MaxRow1, MaxRow2)
ReDim AA(1 To MaxRow, 1 To 1)
For i = 1 To MaxRow
AA(i, 1) = i
Next i
Worksheets("Sheet1").Range("A1").Resize(MaxRow1) = AA
Worksheets("Sheet2").Range("A1").Resize(MaxRow2) = AA
のようにするだけで,かかる時間は圧倒的に少なくなります。

投稿日時 - 2016-11-02 12:52:21

補足

サンプルをありがとうございます。
目的はパフォーマンスの改善です。
実際は、↓のようにサブルーチンを使用してセルに値を入れています。
他にもいくつか条件指定が有り、同じサブルーチンを使用しています。
このケースで、変数AAの扱い方がわかりません。
教えていただけないでしょうか?


Dim i As Long, a As Long, b As Long, MaxRow1 As Long, MaxRow2 As Long
MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To MaxRow1
a = a + 1
Call proc1(i, a)
.
Next i

For i = 1 To MaxRow2
b = b + 1
Call proc2(i, b)
.
Next i

Sub proc1(ByVal i As Long, ByVal a As Long)
Worksheets("Sheet1").Cells(i, a).Value = i


End Sub

Sub proc2(ByVal i As Long, ByVal a As Long)
Worksheets("Sheet2").Cells(i, a).Value = i


End Sub

投稿日時 - 2016-11-03 14:57:25

ANo.1

Ifの中にFor は書けません。For 1つに必ずNextは1つです。
このようにすればいいです。
'
Option Explicit
'
Sub Macro1()
'
' Macro1 Macro
'
  Dim i As Long
  Dim MaxRow1 As Long
  Dim MaxRow2 As Long
'
  MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
'
  For i = 1 To WorksheetFunction.Max(MaxRow1, MaxRow2)
    Worksheets("Sheet1").Cells(i, 1).Value = i
    Worksheets("Sheet2").Cells(i, 1).Value = i
  Next i
End Sub

投稿日時 - 2016-11-02 12:48:13