• 締切済み

Excel VBA offset()関数で質問

Excel VBA offset()関数で質問です。 現在集計のマクロを作成しております。 ■処理内容 各sheetの特定の範囲を"copy" して集計sheetに順に貼り付け… といった処理をさせようと作成中です。 以下がソースになります。 Sub 集計() Dim ws As Worksheet i = 1 For Each ws In ActiveWorkbook.Sheets If ws.Name = "集計" Then Else Range("E1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy ★Worksheets("集計").Range("A1").Offset(, i).Select ActiveSheet.Paste i = i + 1 On Error Resume Next ActiveSheet.Next.Select End If Next End Sub ★マークのところで現在エラーになっています。 実行時エラー '1004': RangeクラスのSelectメソッドが失敗しました。 と表示されます。 offset関数の使用方法の確認ですが… (とあるWebから抜粋したのですが… (^^; ) 例> Range("C3").Offset(,1).Selectとすれば、 行はそのままで、列が1列右に移動し、D3を選択します。 アドバイスよろしくお願い致します。

みんなの回答

  • wine_labo
  • ベストアンサー率86% (73/84)
回答No.1

これでいかがでしょうか? Sub 集計() Dim ws As Worksheet i = 1 For Each ws In ActiveWorkbook.Sheets If ws.Name = "集計" Then Else ws.Activate ws.Range("E1").Select ws.Range(Selection, Selection.End(xlDown)).Select Selection.Copy Worksheets("集計").Activate Worksheets("集計").Range("A1").Offset(, i).Select ActiveSheet.Paste i = i + 1 On Error Resume Next ActiveSheet.Next.Select End If Next End Sub ※ .Activate は .Select でもいいです 複数シートを扱う場合は特に、シートの指定は省略しないで対象シートをアクティブにしないとエラーとなるようです。 シート指定は面倒がらず、省略せず指定するよう心がけるほうがいいと思います。 そのほうが後で見直すときにも対象がどこなのか分かりやすくていいと思います。 省略してしまうと自分で期待している動作をしているものと決め付けてしまい ハマってしまうこともありますので・・・・・ コーディング上省略できる場合でも、省略しないほうが分かりやすい場合もありますので 時と場合に応じて理解しやすいコーディングとなるようにすると後で見直すときにも分かりやすいと思います。

参考URL:
http://www6.plala.or.jp/MilkHouse/begin/contents201/contents20101.html

関連するQ&A

  • エクセルVBAのRand()関数は?

    エクセルでマクロを書いているのですが Rand()関数を使用しようとするとエラーが起きてしまいます。。 アドインは全てインストールしているのですが、原因がわかりません。 知っている方しましたら、ご教授お願い致します。 ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Private Sub btnCreate_Click() 'ループ用の行数。 maxQuestion = 30 'ランダム用の最大値 maxRowCnt = ActiveSheet.UsedRange.Rows.Count For i = 1 To maxQuestion 'ランダムでコピーし貼り付け Sheets("Answer").Select rndm = Int(rand() * (maxRowCnt - 1) + 1) Sheets("Answer").Range("A" & rndm & ":" & "C" & rndm).Select Selection.Copy Sheets("Question").Select Range("A" & i).Select ActiveSheet.Paste delCol = Int(rand() * (2 - 1) + 1) If (delCol = 1) Then Sheets("Question").Cells(i, 1).Value = "" Else Sheets("Question").Cells(i, 2).Value = "" End If Next i End Sub

  • EXCELのVBAについて

    マクロのボタンで内容を削除する様に設定した所、 Dim re As Integer Sheets("投入シート").Select re = MsgBox("入力データをクリアします。" & vbCrLf & vbCrLf & "よろしいですか?", vbOKCancel, "クリア確認") If re <> vbCancel Then Sheets("投入シート").Select ActiveSheet.Unprotect Range("a1:c30").Select Selection.Copy Application.CutCopyMode = False Selection.Copy Sheets("work").Select Range("A1").Select ActiveSheet.Paste Sheets("投入シート").Select ActiveSheet.Unprotect Range("c4:c30").Select Selection.ClearContents Range("f31").Select Selection.Copy Range("c9").Select ActiveSheet.Paste Range("f33").Select Selection.Copy Range("c11").Select ActiveSheet.Paste Range("f32").Select Application.CutCopyMode = False Selection.Copy Range("c14").Select ActiveSheet.Paste Range("c4").Select Application.CutCopyMode = False 'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If Sheets("投入シート").Select Range("c4").Select End Sub この様に入力したのですがセルのC11の計算式だけセル番号が消えてしまいます。 どうしてでしょうか?ご指導をお願いします。

  • Excel VBAについて

    Excelで、指定したセル範囲の外枠に罫線を引き四角形を作り、B1の数字を変えていくと四角形を横に描いていくというマクロを作成したのですが、B1の数値を変えてマクロを実行すると以前に描いた四角形が残ってしまいます。これを数値を変えてマクロを実行すると、以前の四角形を消して新たに四角形を描くにはどうすればよいのでしょうか。何かいい方法があれば教えてください。宜しくお願いします。以下にコードを示しておきます。 Public Sub Main_Code() a = ThisWorkbook.Worksheets("Sheet1").Range("B1") If a = 2 Then Range("I26:K35").Select Selection.BorderAround Weight:=xlMedium Range("B1").Select ElseIf a > 2 Then Dim i As Integer For i = 3 To a Range("I26:K35").Select Selection.BorderAround Weight:=xlMedium Range("I26:K35").Select Selection.Copy Cells(26, 3 * i + 3).Select ActiveSheet.Paste Application.CutCopyMode = False Range("B1").Select  Next i  End If End Sub

  • Excel VBA if文 マクロ強制終了するには?

    現在 2つのbookがあります。 ・データ data.xls ・集計 total.xls ★条件は以下 ・この2つのbookには同じ名前の 『sheet名・数』が情報保持しています。 ・sheet名は不特定の名前が付けられています。 ★処理したいマクロ内容 ・data.xls …の各sheet と total.xls 各sheet参照させて マッチしたら処理。 マッチしなかったらマクロ強制終了。 Sub match() Dim i As Integer For i = 1 To Worksheets.Count '任意のbookを指定します Windows("data.xls").Activate sheet_copy = ActiveSheet.Name Sheets(sheet_copy).Select '範囲を選択 コピーします Range("C2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy On Error Resume Next '---前後にシートが無い場合のエラーを無視 ActiveSheet.Next.Select '任意のbook と sheet を指定します Windows("total.xls").Activate sheet_paste = ActiveSheet.Name Sheets(sheet_paste).Select Range("D2").Select If sheet_copy = sheet_paste Then ActiveSheet.Paste ActiveSheet.Next.Select Else MsgBox "sheet miss match error!" '★マクロ強制終了 End If Next i End Sub ★部分に何と記述すればよろしいでしょうか? アドバイスお願い致します。

  • やはり図形のクリアで実行時エラー1004

     図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing  (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub

  • エクセルVBA-カウンター i と j の使い方

    2つの条件を同時に満たすと図形を別のワークシートにコピーし、600行程度あるワークシートなので For - Next を使ってその作業を繰り返す、というエクセルのマクロを以下のように書き込みました。ところがマクロを実行すると、一番最初の行だけ正確に実行され、次に条件を満たす行があっても図形がコピーされません。(ということはカウンター i, j の使い方が間違っているのです)どなたか私の素人コードを見て修正方法を教えてください。お願いします。 Sub finalize() Dim MyStr As String Dim i As Long Dim j As Long  For j = 2 To 1482 Step 40 For i = 3 To 188 Step 5 MyStr = Range("O" & i) If MyStr <> "" Then                    '条件1 If Range("L" & i).Value = "毎日" Then      '条件2   Sheets("図形_現読").Select ActiveSheet.Shapes.Range(Array("毎日")).Select Selection.Copy Sheets("印刷画面").Select Range("AG" & j).Select ActiveSheet.Paste Else If Range("L" & i).Value = "朝刊" Then Sheets("図形_現読").Select ActiveSheet.Shapes.Range(Array("朝刊")).Select Selection.Copy Sheets("印刷画面").Select Range("AG" & j).Select ActiveSheet.Paste End If End If End If Next i Next j End Sub

  • マクロ 繰り返し offset

    マクロについての質問です。 私自身まだ勉強中でまだ初心者です。 マクロを作ってみたのですが、自分の思い通りに動いてくれません。 どなたか詳しい方ご教授いただけませんか? 下記にマクロのせておきます。 Sheets("Sペストリ").Select For i = 1 To 10 Range("D3").Select ActiveCell.Offset(0, 1).Select If ActiveCell.Value = "" Then Exit For Else Selection.Copy Sheets("印刷").Select Range("A1").Select ActiveCell.Offset(1, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If Next i End Sub 私がやりたいことは、SペストリというシートのD3セルを選びそこから右にコピーしながらブランクが来るまでOFFSETし、印刷シートのA1セルから下にコピーしたセルの情報んペーストOFFSETしていく感じにしたいのですがうまくいきません。 よろしくお願いいたします。

  • vba  

    VBAはじめたばかりで、躓きました。 下記を実行すると、”Nextに対するForがありません。”とでます。 なぜこうなるのか教えてください。  G2~列2000の間が空白になるまで、  下記の処理を続けるようにしたいと思っています。  Dim i As Integer For i = 7 To 2000 Do If Cells(2, i) = "" Then Range("G2").End(xlToRight).Select ActiveCell.CurrentRegion.Resize(6, 5).Select Selection.Cut Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste Exit Do End If Next i Loop  よろしくお願いします。

  • EXCEL VBA

    まことに幼稚な質問で申し訳ないが、バックに合って困っています。 どなたか教えていただけませんか?PCの先生はソフトのバグ!ではないかと云っています。 QT Sub データを作業場に1A() Sheets("データ").Select Range("A1:AB2000").Select  Selection.Copy  Sheets("作業場").Select  Range("A1").Select  ActiveSheet.Paste End Sub UQT Selection.Copyのところで”アプリケーション、オブジェクト等の定義エラーとでます。目を皿のようにしても虫はいないと思いますが? SELECTION.CUTの場合は問題ないのですが! 以上よろしくお願いします。  

  • Excel VBA 連番印刷

    昨日以下の質問をさせていただいた者です。 http://okwave.jp/qa/q8349562.html こちらで教えていただいた以下のコードに、 J2のセルに連番を振るコードを付け足したいと思い、 同じくこちらのサイトの過去の履歴にあった以下コードを参考にとやってみているのですが、 Next で指定された変数の参照が無効です。と言われてしまいます… 印刷部数の指定はいらず、sheet印刷のJ2セルに1から始まる連番を振りたいのです。 どのように修正をしたらいいのかご教示願います。 Sub Sample4() Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet Set wS1 = Worksheets("DB") Set wS2 = Worksheets("印刷") Set wS3 = Worksheets("Sheet3") endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True wS1.Range("A:A").Copy wS3.Range("A1") wS1.ShowAllData For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row If endRow2 > 9 Then Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents End If wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A") wS2.Range("B6") = wS3.Cells(i, "A") Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible) Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible) myArea1.Copy wS2.Activate ActiveSheet.Range("B10").Select Selection.PasteSpecial Paste:=xlPasteValues myArea2.Copy wS2.Activate ActiveSheet.Range("J10").Select Selection.PasteSpecial Paste:=xlPasteValues endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row 'Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut Next i wS1.AutoFilterMode = False wS3.Cells.Clear End Sub 連番印刷のコード Sub NumberPrint() Dim idx As Integer Dim res  res = Application.InputBox("印刷部数を入力してください", Type:=1)  If res > 0 Then   For idx = 1 To res    Range("AW3").Value = idx    ActiveSheet.PrintOut   Next idx  End If End Sub