添付画像の表が複数あります。画像の赤色セルように、1行の間隔でセル範囲を選択し、表の数だけ繰り返して、すべての範囲に対して下記のような処理を行いたいです。表の選択行数が増えた場合をや表の数が増えた場合を考慮した記述にしたいと思っております。
また、行数や表数が増えた場合、どの箇所を修正するのかを併せて教えていただけると助かります。
お手数お掛けいたしますが、よろしくお願い致します。
================================================================
Sub セルの範囲選択()
Set Target = Intersect(Target, Rang("C9:CH9,C11:CH11,C13:CH13,C15:CH15,C17:CH17,C19:CH19,C21:CH21,C23:CH23,C25:CH25,C27:CH27,C37:CH37,C39:CH39,C41:CH41~繰り返す"))
If 処理1
End If
End Sub
============================================================
No.4ベストアンサー
- 回答日時:
何度もごめんなさい。
投稿後、もう一度お礼欄のコードを見直してみました。
結局↓のような感じをご希望だったのでしょうか?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28
For k = i To i + 18 Step 2
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
If Intersect(Target, myRange) Is Nothing Then Exit Sub
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End Sub
※ もし上記方法で良い場合は、
>Set Target = Intersect(Target, Range(myRange))
>If Target Is Nothing Then
>Exit Sub
>Else
の部分を
>If Intersect(Target, myRange) Is Nothing Then Exit Sub
に変更しただけです。m(_ _)m
tom04様
私の質問に何度もご回答くださり、本当にありがとうございました。
私の説明が足りず、ご面倒お掛けいたし申し訳ございません。
ご教示いただいたもので、希望通りの結果を得ることができました。「If Intersect(Target, myRange) Is Nothing Then Exit Sub」の箇所がエラーの原因だったのですね。VBAは本当に奥が深いというか、難しいですね。
完璧なプログラムを教えていただき感謝いたしております。
No.3
- 回答日時:
ん~~~
やりたいコトがなかなか見えてこないのですが・・・
お示しのコードを拝見すると、ダブルクリックするたびに、各行に色付けをするような感じで
反応が若干遅くなるのでは?
前回の1行おきの行の色付けのマクロとダブルクリックのイベントプロシージャーを
別々にしてはダメなのですか?
とりあえず、1行おきのセルを一気に選択し、色付けするのではなく、
↓のコードで一旦マクロを実行しておきます。
Sub Sample3()
Dim i As Long, k As Long, lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 8 Then
Range(Cells(9, "C"), Cells(lastRow, "CH")).Interior.ColorIndex = xlNone
End If
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28
For k = i To i + 18 Step 2
Cells(k, "C").Resize(, 84).Interior.ColorIndex = 3
Next k
Next i
End Sub
ここまでは前回の「セル選択」 → 選択セルに色付け と同じ結果となります。
次にシートモジュールに↓のコードをコピー&ペーストし、範囲内をダブルクリック!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column >= 3 And .Column <= 86 Then
Cancel = True
If .Interior.ColorIndex = 3 Then
If .Value = 1 Then
.ClearContents
.Font.ColorIndex = xlAutomatic
.Interior.ColorIndex = xlNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
'↓不要かも・・・
ElseIf .Offset(, -1).Interior.ColorIndex = 3 Or .Offset(, 1).Interior.ColorIndex = 3 Then
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
'↑ここまで不要?
End If
End If
End With
End Sub
※ 実際どんなことをやりたいのか説明があると
もっと的確な方法を提案できると思います。m(_ _)m
No.2
- 回答日時:
No.1です。
補足を読みました。
要は行合わせだけのです。
実状に合わせてください。
尚、A列が2行ずつ結合してあり、データが必要量だけ入っているとします。
Sub Sample2()
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28 '9行目~A列最終行まで28行おき
For k = i To i + 18 Step 2 'i 行目 ~ i 行プラス18行目まで1行おき
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
myRange.Select
End Sub
こんなんではどうでしょうか?m(_ _)m
この回答への補足
ご回答ありがとうございます。
おかげ様で希望の結果を得られました。
頂いた結果を使い、「Set Target = Intersect
」にて下記のようなクリックイベントの設定をしたいと思っているのですが、なぜかうまく動きません。
何度もお手数お掛けして申し訳ございませんが、アドバイスをいただければと思います。
お手数お掛けいたしますが、よろしくお願い致します。
'=================================================
Private Sub 範囲指定_10件DoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84) '←開始行を指定("C9:CH84)
For i = 9 To Cells(Rows.Count, "B").End(xlUp).Row - 1 Step 28
'↑B列で最終行を取得し、選択開始行と最後の表の選択終了行をstepで指定する(28行ごとに繰返す)
'↓10回繰り返す(繰り返す回数だけ「 Cells(i + 2, "C").Resize(, 84))」を9回追記)
'↓10回繰り返す(繰り返す回数だけ「 Cells(i + 2, "C").Resize(, 84))」を9回追記)
Set myRange = Union(myRange, Cells(i, "C").Resize(, 84), Cells(i + 2, "C").Resize(, 84), Cells(i + 4, "C").Resize(, 84), _
Cells(i + 6, "C").Resize(, 84), Cells(i + 8, "C").Resize(, 84), Cells(i + 10, "C").Resize(, 84), Cells(i + 12, "C").Resize(, 84), _
Cells(i + 14, "C").Resize(, 84), Cells(i + 16, "C").Resize(, 84), Cells(i + 18, "C").Resize(, 84))
Next i
Set Target = Intersect(Target, Range(myRange))
If Target Is Nothing Then
Exit Sub
Else
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End If
End Sub
'=================================================
すみません。補足に記載したプログラムに誤りがありましたので訂正させていただきます。
正しくは、以下になります。大変失礼いたしました。
※Set Target = Intersect(Target, Range(myRange))以降は同じです。
お手数お掛けいたしますが、アドバイスいただければと思います。よろしくお願い致します。
'=================================================
Sub Sample2()
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28 '9行目~A列最終行まで28行おき
For k = i To i + 18 Step 2 'i 行目 ~ i 行プラス18行目まで1行おき
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
Set Target = Intersect(Target, Range(myRange))
If Target Is Nothing Then
Exit Sub
Else
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End If
End Sub
No.1
- 回答日時:
こんにちは!
画像が小さくて規則性が判りにくいので、
単純に色付きセルだけを選択するようにしてみました。
http://oshiete.goo.ne.jp/qa/8536916.html
のNo.2さんの方法と似ていますが、
Excel2010をお使いのようですので、Excel2010以降で使える「DisplayFormat」を使ってみました。
(条件付き書式で色がついている場合でも対応できます)
Sub Sample1()
Dim i As Long, k As Long, myRange As Range
For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row 'A列で最終行を取得
If Cells(i, "C").DisplayFormat.Interior.ColorIndex <> xlNone Then 'C列で色付き行を判断
Set myRange = Cells(i, "C").Resize(, 84) ' 一旦 C~CH列最初の色付きセルを「myRange」にセット
Exit For 'ループを抜ける
End If
Next i
For k = i To Cells(Rows.Count, "A").End(xlUp).Row 'C列で色付きセルがあった行~A列最終行まで
If Cells(k, "C").DisplayFormat.Interior.ColorIndex <> xlNone Then
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
End If
Next k
myRange.Select
End Sub
※ 表外(項目行など)に色付きセルがある場合も選択されてしまいます。m(_ _)m
この回答への補足
ご回答ありがとうございます。
添付画像の表について、赤色セルの箇所(C9:CH9からC27:CH27まで1行おきに10行選択)を選択します。
そして、次表も同様に1行ごとに選択します。(C37:CH37からC55:CH55まで1行おきに10行選択)を選択を表数分だけ繰り返します。
ただし、1つ目の表の選択最終行から次表の選択開始行との行は選択不要のため(C28:CH36まで)無視します。
1つめの表の選択範囲:C9:CH9からC27:CH27
次表までの選択不要な範囲:C28:CH36は無視する
2つ目の表:C37:CH37からC55:CH55
次表までの選択不要な範囲:C256:CH64は無視する
3つ目の表:C65:CH65からC84:CH84
次表までの選択不要な範囲:C85:CH91は無視する
~以下次表までの繰り返し
表数が増えると、最後に選択した行とと次表見出し行との行数が10行あるため
選択範囲が全体的にずれてしまいました。
行数や表数が増えた場合、どの箇所を修正するのかを併せて教えていただけると助かります。
お手数お掛けいたしますが、よろしくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excel VBAの解読について質問があります。 概要は、マクロでチェックボックスにチェックすると日 1 2023/02/10 07:50
- C言語・C++・C# プログラミングの授業の課題です 1 2023/01/17 22:15
- C言語・C++・C# C++のcinの動作 5 2023/02/26 00:13
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- 大学受験 高校化学の有機分野です。 この構造式で表される立体異性体は3種類ですが この場合ってc=cに結合して 3 2022/09/28 11:14
- C言語・C++・C# 現在プログラムを作っているのですが、実行したときに写真のように結果が表示されるのですが、これを CH 2 2023/01/18 16:22
- 化学 応えを教えてください 1 2023/08/06 17:39
- PHP PostgreSQLからCSV形式でエクスポートする際にカラム内の改行をとる方法 1 2023/02/22 10:05
- Excel(エクセル) VBA 特定の列に入っているテキストをコピペ 2 2023/06/14 11:24
- 物理学 磁性体に関する熱力学の問題が分かりません 1 2023/07/18 03:23
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル マクロ オートフィ...
-
エクセルで特定の文字列が入っ...
-
[EXCEL]ボタン押す→時刻が表に...
-
【Excel関数】UNIQUE関数で"0"...
-
エクセル 上下で列幅を変えるには
-
Excel 時刻の並び替え
-
結合されたセルをプルダウンの...
-
エクセルマクロで偶数行(又は...
-
エクセル マクロで数値が変っ...
-
エクセルVBA:リストに登録した...
-
AのセルとB行を比較して、一致...
-
【EXCEL】連続データの個数を抽...
-
Excel グラフのプロットからデ...
-
Excel ウインドウ枠の固定をす...
-
エクセルのマクロで意図しない...
-
excel 小さすぎて見えないセル...
-
特定の文字がある行以外を削除...
-
エクセル2016で時間を入力して...
-
エクセルのセルに指定画像(.jpg...
-
エクセルVBA:データ端に画...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
結合されたセルをプルダウンの...
-
[EXCEL]ボタン押す→時刻が表に...
-
excel 小さすぎて見えないセル...
-
AのセルとB行を比較して、一致...
-
エクセル マクロで数値が変っ...
-
エクセル 上下で列幅を変えるには
-
excelのデータで色つき行の抽出...
-
Excel グラフのプロットからデ...
-
エクセル2016で時間を入力して...
-
VBAで色の付いているセルの行削除
-
特定の文字がある行以外を削除...
-
連続データが入った行の一番右...
-
エクセルVBA 最終行を選んで並...
-
エクセルのセルに指定画像(.jpg...
-
エクセルで昨日までの日付デー...
-
エクセルマクロで偶数行(又は...
-
A1に入力された文字列と同じ文...
おすすめ情報