VBA コード

超初心者なのですが、アナログで不毛な作業を何とかしたいので勉強中です。
VBAで下記のコードを入力し実行したいのですがご教示頂けませんでしょうか。

例
①指定範囲（セルA6からA300）を選択しコピー
②指定範囲（セルF2からDU2）のうち最大値の列の6行目から300行目に①を「数値のみ」貼付け

初心者にも分かりやすく解説頂けると幸いです。
宜しくお願い致します。

No.4 ベストアンサー 回答者： fujillin 回答日時： 2023/12/13 14:19

No3です。

＞１つ１つ転記する形になりかなり時間がかかってしまいました。
VBAの場合、シートへのアクセスに時間がかかるので、その回数を減らすようにすることで速度向上を図れます。
（速度だけを言えば、他にもいろいろありますので、検索してみてください）
とは言え、高々150セルの転記程度で時間がかかるとも思えません。
（よほど悪い環境で処理をしていれば別ですが・・）

シートへのアクセスを減らすには、まとめて読み書きするのが効果的です。
以下は、A7:A300のうちの奇数行をB列に転記する内容での例です。

Sub Sample1()
Dim V, i
V = Range("A1:A299").Value
For i = 7 To 299 Step 2
Cells(i, 2).Value = V(i, 1)
Next i
End Sub

A列へのアクセスを1回にしているので、全体でシートへのアクセス回数を半減できます。
B列に関数式がないという条件が保証されているならば、B列も同様にまとめて処理するようにして、

Sub Sample2()
Dim VA, VB, i
VA = Range("A7:A299").Value
VB = Range("B7:B299").Value
For i = 1 To 293 Step 2
VB(i, 1) = VA(i, 1)
Next i
Range("B7:B299").Value = VB
End Sub

などとすることで、シートへのアクセスを最小で済ませることが可能になります。


※ 最初にも記しましたが、150セル程度であれば、ほとんど差は感じられないはずと思いますので、あくまでもご参考までに。

この回答へのお礼

何とか出来ました！感動です！！

最初の質問と奇数行のみを組み合わせて
①指定範囲（セルA6からA300）を選択しコピー
②指定範囲（セルF2からDU2）のうち最大値の列の6行目から300行目に①の「奇数行」を「数値のみ」貼付け
を下記で作ってみたら高速で実行でき（間違ってるかもしれませんが・・）
感激しています。

Sub

Dim rg As Range, n As Long

Dim VA, VB, i
VA = Range("A7:A300").Value
VB = Cells(7, n + 5).Resize(295).Value
For i = 1 To 294 Step 2
VB(i, 1) = VA(i, 1)
Next i

Set rg = Range("F2:DU2")
If Application.Count(rg) = 0 Then Exit Sub
n = Application.Match(Application.Max(rg), rg, 0)
Cells(7, n + 5).Resize(294).Value = Range("A7:A300").Value

End Sub

何度も初歩的な事ばかり聞いてすみませんでした。
おかげ様で大変勉強になり助かりました。
ありがとうございました！！

お礼日時：2023/12/13 16:04

No.3 回答者： fujillin 回答日時： 2023/12/12 21:55

No1です。

＞A6:A300の奇数行のみをコピーして貼り付ける（値のみ）事も可能でしょうか。
可能ですが、範囲が連続セルでない場合は、1センテンスでは無理です。
セル範囲をループして、奇数行のみ転記するようにしてください。

この回答へのお礼

最初に頂いたコードだと高速で動かせたのでこれで行きたいのですが、Dim ｎ As Integerをどこに入れればいいのでしょうか？
それとも別の考え方でしょうか？
No.2さんを参考に組んでみたら１つ１つ転記する形になりかなり時間がかかってしまいました。

Sub Q13679174()
Dim rg As Range, n As Long

Set rg = Range("F2:DU2")
If Application.Count(rg) = 0 Then Exit Sub
n = Application.Match(Application.Max(rg), rg, 0)
Cells(6, n + 5).Resize(295).Value = Range("A6:A300").Value

End Sub

すみませんが、ご教示下さい。

お礼日時：2023/12/13 09:35

No.2 回答者： lv4u 回答日時： 2023/12/12 17:24

以下はChatGPTの回答です。

Sub PasteValues()

' ①指定範囲（セルA6からA300）を選択しコピー
Range("A6:A300").Select
Selection.Copy

' ②指定範囲（セルF2からDU2）のうち最大値の列の6行目から300行目に①を「数値のみ」貼付け
Dim maxCol As Integer ' 最大値がある列の列番号を格納する変数
Dim maxVal As Double ' 最大値を格納する変数
Dim i As Integer ' ループ用の変数

' セルF2からDU2のうち最大値のある列の列番号を取得
maxCol = Application.WorksheetFunction.Match(WorksheetFunction.Max(Range("F2:DU2")), Range("F2:DU2"), 0)

' 最大値のある列の6行目から300行目に値を貼り付け
For i = 6 To 300
Range(Cells(i, maxCol), Cells(i, maxCol)).PasteSpecial Paste:=xlPasteValues
Next i

' クリップボードのコピーを解除
Application.CutCopyMode = False

この回答へのお礼

ありがとうございます。
私もbingのチャット機能で調べたら若干意図が外れていたのですが、ChatGPTだとかなり正確に導けるものなんですね。
因みに、同上でA6:A300の奇数行のみをコピーして貼り付ける（値のみ）事も可能でしょうか。

お礼日時：2023/12/12 21:09

No.1 回答者： fujillin 回答日時： 2023/12/12 17:02

こんばんは

不明点は勝手に解釈しました。
以下、ご参考までに。

※ 「最大値」とは数値の最大値と解釈しました。
※ F2:DU2に数値が存在しない場合には何もしません。
※ 最大値が複数存在する場合は、列番号の小さい列を対象とします。
※ A6:A300の内容が数値かどうかのチェックはしていません。
　 セルの値を「値をペースト」と同等に転記します。

Sub Q13679174()
Dim rg As Range, n As Long

Set rg = Range("F2:DU2")
If Application.Count(rg) = 0 Then Exit Sub
n = Application.Match(Application.Max(rg), rg, 0)
Cells(6, n + 5).Resize(295).Value = Range("A6:A300").Value

End Sub

この回答へのお礼

出来ました！
丁寧に解答頂きありがとうございます。
自分なりに調べたらもっと長いコードになってしまったのですが、こんなにシンプルになるのですね。
因みに、同上でA6:A300の奇数行のみをコピーして貼り付ける（値のみ）事も可能でしょうか。

お礼日時：2023/12/12 20:41