• ベストアンサー

マクロ

宜しくお願いいたします セルを選択するマクロですが、何処か間違っているので 実行すると、K25のみ選択されてしまいます 一行おきに選択したいのですが 以下のマクロです Sub セルの選択2() Dim ColPos As Integer Dim RowPos As Integer For ColPos = 1 To 11 Step 2 For RowPos = 5 To 25 Step 2 Cells(RowPos, ColPos).Select Next Next End Sub

  • ok136
  • お礼率77% (254/328)

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

  • ベストアンサー
noname#101556
noname#101556
回答No.1

Unionメソッドを使うとできます。 ---------------------- Sub セルの選択3() Dim ColPos As Integer Dim RowPos As Integer Dim r1 As Range Set r1 = Cells(5, 1) For ColPos = 1 To 11 Step 2 For RowPos = 5 To 25 Step 2 Set r1 = Union(r1, Cells(RowPos, ColPos)) Next Next r1.Select End Sub ---------------------- r1は初期化しておく必要があるようです。 この例ではループの初回が無意味ですが、適宜修正願います。

ok136
質問者

お礼

有難うございました お蔭様で、選択できました。

  1. カテゴリ
  2. インターネット・Webサービス
  3. その他（インターネット・Webサービス）

関連するQ&A

  • マクロが実行しない

    　二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub

  • エクセルマクロで教えてください

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

  • マクロ：複数セルの選択

    VBA初心者です。以前こちらで以下のようなマクロを教えていただきました。 Dim r As Integer Dim c As Integer c = 3 For r = 8 To 100 Sheets("table").Select Cells(r, c).Select Selection.Copy C列8行から100行まで繰り返し選ぶのですが、単体セルではなく複数のセル（レンジ）を 指定する場合は「Cells(r, c).Select」の代わりにどのように表記すればよろしいでしょうか。 （例えば　C8:Z8） 宜しくお願いいたします。

  • このマクロ、どこがおかしいですか？

    i5とj5のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i5とj5のセルに何も書かれていないときはそのまま一つ下の列へ行き、行った先のセルでも同じように処理(i6とj6のセルの文字が同じ場合はセル同士を結合して一つ下の行へ行き、i6とj6のセルに何も書かれていないときはそのまま一つ下の列へ行き)を繰り返し、と言うことをi33とj33のセルまで続けたいと思っています。 Sub よろしくお願いします() Dim i As Integer For i = 5 To 33 Cells(i, 9).Select If Cells(i, 9).Value = Cells(i, 10).Value Then Range(Cells(i, 9), Cells(i, 10)).Merge Selection.Offset(i + 1).Select ElseIf Cells(i, 9).Value = "" Then Selection.Offset(i + 1).Select Next i End If End Sub と書いたのですが、『Nextに対応するForがありません』と言われてしまいます。どうすれば思い通りにできるでしょうか？ 極めて初心者で、伝わりにくい点があるかもしれません。よろしくお願いします。

  • 判定してセルを塗りつぶすマクロについて

    判定してセルを塗りつぶすマクロについて教えて下さい。 現在下記のようなマクロがあります。 Sub オニオン判定() Dim i As Integer, j As Integer, r As Integer Dim k As Double Range(Cells(17, 9), Cells(26, 14)).Interior.ColorIndex = 0 Range(Cells(30, 9), Cells(39, 14)).Interior.ColorIndex = 0 k = Cells(5, 2) 'B5セルの値 For j = 9 To 14 For i = 17 To 26 For r = 30 To 39 If Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then Cells(r, j).Interior.Color = vbYellow Cells(i, j).Interior.Color = vbYellow End If Next  Next   Next End Sub 対象のIf Abs(Cells(i, j).Value - Cells(r, j).Value) <= 0.05 Then で、それぞれ見比べて、0.05以上のずれがあるとセルが塗りつぶされないというマクロなのですが これを、If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenという条件も追加して その時はセルを青に塗りつぶし、逆に0.05以上のずれがあるセルは赤に塗りつぶす。 みたいなマクロを書きたいです。 If Abs(Cells(i, j).Value - Cells(r, j).Value) = 0 Thenは一度追加してみましたが 上手く機能しませんでした。 やりたい事 ・数値が動いているけど、0.05以内の時は黄色 ・数値変動が0の場合は青 ・数値変動が0.05以上の場合は赤 です。 宜しくお願いします。

  • マクロのプロシージャーの修正

    シートの加工場設定マスタの列が最初は、Ｂ列の４行目からＤ列の３０行まで あったのですが、Ｂ列が不要になったのでＢ列を削除しました。 下記のようなマクロを記述していますが何処を修正すればよいか 教えてください。 Private bmas(20,3) Sub Kmas_call() Dim i As Integer, j As Integer, k As Integer Windows("加工品.xls").Activate Sheets("加工場設定マスタ").Select For i = 1 To 20 For j = 1 To 3 Bmas(i, j) = Cells(i + 4, j + 1) Next j Next i End Sub

  • このマクロの繰り返し？

    もう、なにがなんやらで・・・ このマクロの繰り返しを入れ子で出来ないでしょうか? 加算しながら増やしていくので、わけわからなくなりそうです。 Option Explicit Sub hiat() Cells.Clear Dim s As Long, a As Long, b As Long, c As Long, d As Long, e As Long For a = 1 To 31 s = Rnd * 4 Cells(a, 1) = s If s >= 4 Then Exit For '4がでたら終わり。 Next For b = 2 To 31 s = Rnd * 4 Cells(a, b) = s If s >= 4 Then Exit For '4がでたら終わり。 Next Cells(a + 1, b).Select 'セルの移動 Cells(a + 1, b).Activate For c = 1 To 31 - a s = Rnd * 4 ActiveCell(c) = s If s >= 4 Then Exit For '4がでたら終わり。 Next Cells(a + c, b + 1).Select 'セルの移動 Cells(a + c, b + 1).Activate For d = 1 To 31 - a - c s = Rnd * 4 ActiveCell(d) = s If s >= 4 Then Exit For '4がでたら終わり。 Next Cells(a + c + d - 1, b + 2).Select 'セルの移動 Cells(a + c + d - 1, b + 2).Activate For e = 1 To 31 - a - b - c - d s = Rnd * 4 ActiveCell(e) = s If s >= 4 Then Exit For '4がでたら終わり。 Next Cells(a + c + e - 1, b - 1 + d + 1).Select 'セルの移動 Cells(a + c + e - 1, b - 1 + d + 1).Activate End Sub

  • マクロでのActiveSheet.Pasteでのデバック

    関数の入ったセルを切取りで貼付けたいのですが、ActiveSheet.Pasteのところで"WorksheetクラスのPasteメソッドが失敗しました.”のデバッグになってしまいます。対応を教えていただけないでしょうかお願い致します。 Sub susiki() Columns("A:J").Select Selection.AutoFilter Selection.AutoFilter Field:=6, Criteria1:="AG" Dim kirix As Integer, kiriy As Integer Dim kiriz As Long kiriy = Range("A:A").Column kiriz = Range("F1").End(xlDown).Row For kirix = 1 To kiriy Range(Cells(kiriz, kirix), Cells(kiriz, kirix)).Select Selection.CurrentRegion.Select Selection.Cut Next kirix Selection.AutoFilter Field:=6, Criteria1:="DB" Dim harix As Integer, hariy As Integer Dim hariz As Long hariy = Range("A:A").Column hariz = Range("F1").End(xlDown).Row For harix = 1 To kiriy Range(Cells(hariz, harix), Cells(hariz, harix)).Select ActiveSheet.Paste Next harix Selection.AutoFilter End Sub

  • エクセルのマクロで複数セル指定は？

    以前（7月22日　質問No.936181）の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル（例えばA1からA30の30個のセル）をいっぺんに書き込むようにしたいのですが可能でしょうか？ よろしくお願いします。

  • マクロで塗りつぶしセルのカウント

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する