- ベストアンサー
VBA初心者が複数行の処理を記述する方法
- VBAの初心者ですが、60行の処理を同時に適用する方法を教えてください。
- 私はVBA初心者で、一行分の処理は書けるようになりましたが、複数行の処理を同時に適用する方法がわかりません。
- 現在、私はVBAのコードを書いていますが、一行分の処理しかできません。実際には60行の処理に同じ処理を適用したいのですが、どのように書けばいいのでしょうか?
- みんなの回答 (2)
- 専門家の回答
関連するQ&A
- 色々なものを見ながら作っている初心者です。
色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals
- 締切済み
- オフィス系ソフト
- このVBAの処理を速くしたいのですが…
お世話になります data.xlsmとBook1-Book25.xlsxの 合計26ファイルを開いた状態で 以下のマクロを実行しています 私が使っているマシンでは 10分くらいかかるのですが この時間を短くすることは 出来ますでしょうか? Sub copy() Application.ScreenUpdating = False Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1:D1048576").copy Workbooks("data.xlsm").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues Range("G1:K1048576").Clear Range("A1:E1048576").copy Range("G1:K1048576").PasteSpecial Paste:=xlPasteValues Range("I2").ClearContents Range("I1048576").End(xlUp).ClearContents Range("A2:D1048576").Clear Range("O1:Q1").copy Range("S1048576").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues あとは上記をBook2,Book3と変えてBook25まで同じ式を記入 End Sub
- ベストアンサー
- Excel(エクセル)
- 「elseに対応するifがありません」と表示されます。
If Range("a2") > 0 Then GoTo saisyo Else End End If saisyo: Range("a2").Select.Copy Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub とすると、質問タイトルのエラーが出ます。何がいけないのでしょうか?
- ベストアンサー
- オフィス系ソフト
- Excelの三つのVBAを一つにまとめる。
初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ 解る方、よろしくお願いします。
- 締切済み
- オフィス系ソフト
- vba 不揃いの行数にカーソル位置対応
os_xp //// ex_2003 Sub goo() ' goo Macro ' Keyboard Shortcut: Ctrl+g ' Range("A65524").Select Selection.End(xlUp).Select Rows("669:669").Select '(1)-----次回及び 他のシートは不揃いの為 Selection.Copy Rows("670:670").Select '(2)-----(1)が位置が変化するからここも対応 ActiveSheet.Paste Application.CutCopyMode = False Range("A669:F669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("BD669:BG669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("A672").Select '(3)-----次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい End Sub ' 'どのシートでも (1) (2) (3) が対応してくれないか?。 '
- ベストアンサー
- オフィス系ソフト
- VBA Do Until内で値の貼り付けができない
Excel2003を使用しております。 コピー&値のペースト作業をやってくれるマクロを作成しております。 具体的には、名簿に公がついていれば、その3つ左の名前をD27へ値のみコピペし、 D27がすでに値があれば、D28に書くことを、D37までループするようにしております。 しかし困ったことに、Do Untilコードを使用しておりますが、このコードではなぜか値の貼り付けが出来なくなります。 Sub Ns公() Dim work As Range Set work = Selection If Selection.Value = "公" Then ActiveCell.Offset(0, -3).Select Selection.Copy Do Until Range("D37").Select Range("D27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop If Range("D36").Value <> "" Then Do Until Range("I37").Select Range("I27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop work.Select End If work.Select End If work.Select ActiveCell.Offset(1).Select End Sub 原因や対策をご教授いただけるとうれしいです。よろしくお願いします。
- ベストアンサー
- その他(プログラミング・開発)
- 続・VBAでセルに値が入ったときにイベントを起こしたい
http://oshiete1.goo.ne.jp/qa4650025.htmlで教えていただきありがとうございました。大変分かりやすい解説でした。 こういうことが出来るんだーとわかりもっと使いやすいように仕様を変えた方がいいと気づき新たに書き込んでみました。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long ' 変更したセルに値が入った場合条件成立 If Trim(Target.Value) <> "" Then ' 行番号が10以上65530以内のとき条件成立 If Target.Row >= 10 And Target.Row <= 65530 Then ' BCD列で、5の倍数の行のとき条件成立 If (Target.Column = 2) And (Target.Row Mod 5) = 0 Then If Target.Value <> "" Then For i = 0 To 4 Target.Copy Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues Next Worksheets("Sheet4").Range("A2:K6").Copy Target.Offset(5, -1) End If ElseIf (Target.Column = 3) And (Target.Row Mod 5) = 0 Then If Target.Value <> "" Then For i = 0 To 4 Target.Copy Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues Next End If ElseIf (Target.Column = 4) And (Target.Row Mod 5) = 0 Then If Target.Value <> "" Then For i = 0 To 4 Target.Copy Target.Offset(i, 10).PasteSpecial Paste:=xlPasteValues Next End If Else Exit Sub End If End If End If End Sub ここまでは何とか出来たのですが問題点があります・・・ ・複数セルを選択してDELすると実行時エラー13が出ます。(別の回答にあったやつですが・・・) ・別シートより範囲指定したセルをコピーして張り付けるときも出ます。 ・B列には6桁の整数値しか入らないようにしたいけど整数値限定は可能?・・・その整数値を貼り付ける際日付型へのフォーマットが難しい などあります。ヒントをいただけないでしょうか?
- ベストアンサー
- Visual Basic
- VBA初心者です。値を貼り付け について質問です。
VBA初心者です。 値を貼り付け について教えてください。 Sub test() With Workbooks("A.xls").Worksheets("sheet1") .Range("A1").Copy Workbooks("Bxls").Worksheets("sheet1").Range("B2") .Range("A2").Copy Workbooks("B.xls").Worksheets("sheet1").Range("B4") End With End Sub コピーする方に計算式が入っているので 値を貼り付け したいのですが、どうすればいいのでしょうか? PasteSpecial Paste:=xlPasteValues を使ったらよいというところまではわかったのですが・・・。 教えてください!よろしくお願いします!
- 締切済み
- Visual Basic
- VBA空白を除いてコピーが出来ません。ご指導お願いします。
値のコピー&ペースト(空白を除いてコピー)したいと思っております。 シート1 の A35、D35、I35 をコピー。 シート2 の A2 に貼り付け。 これは、大丈夫です。 シート1 の M2 : O23 をコピー。 シート2 の E2 に貼り付け。 今回の場合ですと、M2 : O13 までに値が入ってます。 ですので、M14 : O23 までが、空白になって記入となってしまいます。 *毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14 : O23 までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロ
セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub
- ベストアンサー
- Excel(エクセル)
- 無事退院できた息子の出産入院生活において、気にかけてくださった助産師さんへの感謝の気持ちをお手紙にしたい
- 入院中に体調を心配してくださり、お部屋まで看に来てくださった助産師さんに感謝を伝えたい
- 入院中に退院まで会えないため、助産師さんにお礼を言う機会がないが、お手紙を送っても迷惑ではないか心配
お礼
jcctairaさん、ありがとうございました! 操作したところこちらの希望していたとおりの動作です! ”処理中にまたChangeイベントが発生してしまう可能性があるので入れました”こういう視点がやはり付け焼刃で学習した人間には欠落していました。入門書片手にFindメソッドで試そうかなどと思案してたところです。 専門家ではないですが、自分なりにこれから少しずつ理解を深めたいと思います。 本当にありがとうございました。