- ベストアンサー
エクセルVBA セル範囲の選択とループ処理
- VBA歴がまだ浅い学習者です。エクセルVBAを使用して、セル範囲を選択し、ループ処理を行いたいと思っています。詳しい操作やコードの記述方法を知りたいです。
- 質問の要点は、データのセル範囲を自動で選択する方法と、ループ処理の記述方法です。データが複数の範囲に分かれている場合でも、自動で範囲を選択する方法について教えてください。
- また、データの範囲を選択し、別のシートに貼り付ける方法についても教えてください。ループ処理を行いながらデータを繰り返し処理する方法も知りたいです。
- kenthehg
- お礼率48% (139/284)
- Excel（エクセル）
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
確認したい事があります。 シートSummaryには以前結果を出力した際のデータが残っている場合もあり得ると思うのですが、その様な場合においても、シートDの内容が更新された後であれば、シートSummaryに残っている古いデータは消去してしまっても構わないのでしょうか？ もしそれで宜しければ、次の様なマクロは如何でしょうか。 Sub QNoq8948349_エクセルVBA_セル範囲の選択とループ処理() Dim i, LastR, TopR, BottomR, myRow As Long Dim SheetD, SheetX, SheetY, SheetSu, mySheet As Worksheet Dim ColumnF, ColumnL As String Dim ResultRange As Range Application.ScreenUpdating = False '(処理が終わるまで)画面に現れる表示内容の更新を行わない Set SheetD = Sheets("D") '元データが入力されているシート Set SheetX = Sheets("X") '奇数個目のデータのグループを貼り付けるシート Set SheetY = Sheets("Y") '偶数個目のデータのグループを貼り付けるシート Set SheetSu = Sheets("Summary") '結果を出力するシート Set ResultRange = SheetSu.Range("B2:J2") '一時的な結果が表示されるセル範囲 ColumnF = "A" 'コピー範囲の最初の列 ColumnL = "M" 'コピー範囲の最後の列 LastR = SheetD.Range(ColumnF & Rows.Count).End(xlUp).Row 'コピー範囲の最後の行の行番号を取得 myRow = 0 ResultRange.Offset(1).Resize(Rows.Count _ - ResultRange.Row, ResultRange.Columns.Count).ClearContents '↑以前に記録された古い結果を消去 TopR = 2 'コピーするセル範囲の内の一番上の行 '↓「コピーするセル範囲の内の一番上の行」として指定された行が、最終行よりも上の行である限り、処理を繰り返す Do While TopR < LastR For i = 0 To 1 With SheetD TopR = .Range(ColumnF & TopR).End(xlDown).Row 'コピーするセル範囲の内の一番上の行 BottomR = .Range(ColumnF & TopR).End(xlDown).Row 'コピーするセル範囲の内の一番下の行 End With Select Case i Case Is = 0 'iの値が0の場合は貼り付け先のシートにSheetXを指定 Set mySheet = SheetX Case Is = 1 'iの値が0の場合は貼り付け先のシートにSheetYを指定 Set mySheet = SheetY End Select mySheet.Columns(ColumnF & ":" & ColumnL).ClearContents '貼り付け先のシートの古いデータを消去 SheetD.Range(ColumnF & TopR & ":" & ColumnL & BottomR).Copy '↑コピー元のシートの中から、データの塊を1つコピー mySheet.Range("A1").PasteSpecial Paste:=xlPasteValues '貼り付け先のシートにコピーしたデータを貼り付け TopR = BottomR + 1 '次のTopRの行番号を求めるための下準備として、次の空欄の行を指定 Next i myRow = myRow + 1 'ResultRangeで指定されたセル範囲の何行下に結果を貼り付けるのかを示す数値 ResultRange.Offset(myRow).Value = ResultRange.Value 'ResultRangeに表示されている結果を、その下の行に貼り付け Loop '繰り返し行う処理はここまで Application.CutCopyMode = False 'コピーモードの解除 SheetX.Columns(ColumnF & ":" & ColumnL).ClearContents '不要になったSheetXのデータを消去 SheetY.Columns(ColumnF & ":" & ColumnL).ClearContents '不要になったSheetYのデータを消去 Application.ScreenUpdating = True '画面に現れる表示内容の更新を行うモードに戻す End Sub
その他の回答 (1)
- FEX2053
- ベストアンサー率37% (7991/21372)
VBAを書ける方のようなので、ざっとした発想から。 たぶんこれよりかっこよく書く方法はありますけど、VBAのコードは 「後で見てメンテナンス出来ない」と困りますから、コードが長くなっても 可能な限り「わかりやすい」ことが肝要だ、と私は思っているので。 で、ですね。まずは空欄を探す方法。要はIF文で""を見つければ いいんです。 Cells(開始行,1).Select Do Until Selection.Value="" Selection.Offset(1).select Loop 終了行=Selection.Row これで、開始行、終了行が得られます。あとは Range(Cells(開始行, 1), Cells(終了行, 13)).Select でコピー範囲が得られます。コピーが終われば 開始行=終了行+1 で、さっきのループを回せばオッケーです。
お礼
ありがとうございます。 無事に解決することができました。 わかりやすい文字列をコード内で使うとたしかに、のちのち見やすいですね。 今後も、見直しをしながら、回答者さんのようなわかりやすいコードをかけるようになるよう、頑張ってまいります。
お礼
大変感謝いたします。 見事きれいに実行することができました。 また、書き方、組み立て順序など、非常に勉強になりました。 何度も見直しをしつつ、今後の勉強の参考にさせていただきます。 ありがとうございました。 ＞＞シートSummaryには以前結果を出力した際のデータが残っている場合もあり得ると思うのですが、その様な場合においても、シートDの内容が更新された後であれば、シートSummaryに残っている古いデータは消去してしまっても構わないのでしょうか？ シートＸ，Ｙのことかと存じます。おっしゃる通り、データ行数が可変のため、一旦消去する必要がございました。ご留意くださりありがとうございました。