いつもお世話になっております。
エクセルのマクロを使って(あるいは数式でもいいのですが・・・)やりたいことが2つあります。
(1)指定したセルを「対称の中心」として,アクティブセルと点対称の位置にあるセルに色付けができないかと思っています。
(2)指定した列を「対称の軸」として,アクティブセルと線対称の位置にあるセルに色付けできないかと思っています。
もし可能であるようなら,どなたかマクロを教えていただけませんか?
いつも他力本願で申し訳ないのですが,教育に役立てたいと思っています。どうかご教授ください。
No.3ベストアンサー
- 回答日時:
sub macro1()
’J10セルに対して点対象位置
dim org as range
set org = range("J10")
on error resume next
org.offset(org.row - activecell.row, org.column - activecell.column).interior.colorindex = 4
end sub
sub macro2()
’J列に対して線対象位置
dim org as range
set org = cells(activecell.row, "J")
on error resume next
org.offset(org.row - activecell.row, org.column - activecell.column).interior.colorindex = 6
end sub
#同じマクロを流用していますが,勿論行オフセットをゼロに固定して構いません
No.4
- 回答日時:
遅ればせながら・・・。
下記コードをシートモジュールにコピペッタン。
使い方
A2セルに基準となるアドレスを入れます。
半角で、L10 とか m15 など。
A3セルには、半角小文字で、p h v のいずれか。
p→点
h→水平
v→垂直
A1セルに、半角で0以外を入力。
青(選択セル)に合わせて 赤セルが移動します。
エラー処理は手抜きなので、動かなくなったらエクセルを再起動のこと。
もしかしたらバージョン違いで動かないかも?当方Excel2010。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim rBase As Range '基準点(線)
Dim hB As Integer, vB As Integer
Dim cC '点、縦、横の選択
If Range("A1") = 0 Then Exit Sub
Set rBase = Range(Range("A2").Value)
If Err.Number <> 0 Then Exit Sub
cC = Range("A3").Value
Application.EnableEvents = False
Application.ScreenUpdating = False
'シート内の色をクリア
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'基準点(線)設定
Select Case cC
Case "p"
rBase.Interior.Color = vbBlack
Case "h"
Rows(rBase.Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With
Case "v"
Columns(rBase.Column).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With
End Select
Target.Select
Target.Interior.Color = vbBlue
hB = rBase.Row - Target.Row
vB = rBase.Column - Target.Column
Select Case cC
Case "p"
rBase.Offset(hB, vB).Cells.Interior.Color = vbRed
Case "h"
Cells(rBase.Offset(hB, 0).Row, Target.Column).Cells.Interior.Color = vbRed
Case "v"
Cells(Target.Row, rBase.Offset(0, vB).Column).Cells.Interior.Color = vbRed
End Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
ご教授ありがとうございました。
エラー無く実行できました。
基準値をセル入力できるので,応用が利きそうです。
また何かありましたらよろしくお願いいたします。
No.2
- 回答日時:
こんばんは!
面白そうなのでトライしてみました。
Sheetモジュールです。
Dim myRow As Long, myCol As Long, c As Range, r As Range 'この行から
Dim myX As Long, myY As Long
Sub SAmple1()
If Selection.Count > 1 Then
MsgBox "1セルのみ選択"
Exit Sub
End If
With ActiveSheet
.Cells.ClearContents
.Cells.Interior.ColorIndex = xlNone
End With
With Selection
.Value = "○"
.Font.ColorIndex = 6
.Interior.ColorIndex = 6
End With
MsgBox "点対象の場合はひとつのセルを" & vbCrLf & "線対象の場合は複数セルを選択"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set c = ActiveSheet.Cells.Find(what:="○", LookIn:=xlValues, lookat:=xlWhole)
Set r = ActiveSheet.Cells.Find(what:="×", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing And Not r Is Nothing Then Exit Sub
With Target
If .Count = 1 Then
.Value = "×"
.Font.ColorIndex = 1
.Interior.ColorIndex = 1
myRow = Abs(c.Row - .Row)
myCol = Abs(c.Column - .Column)
If c.Row > .Row Then
myX = myRow * -2
Else
myX = myRow * 2
End If
If c.Column > .Column Then
myY = myCol * -2
Else
myY = myCol * 2
End If
c.Offset(myX, myY).Interior.ColorIndex = 3
ElseIf Target(1).Row = Target(Target.Count).Row Then
.Value = "×"
.Font.ColorIndex = 1
.Interior.ColorIndex = 1
myRow = Abs(c.Row - .Row)
If c.Row > .Row Then
myX = myRow * -2
Else
myX = myRow * 2
End If
c.Offset(myX).Interior.ColorIndex = 3
ElseIf Target(1).Column = Target(Target.Count).Column Then
.Value = "×"
.Font.ColorIndex = 1
.Interior.ColorIndex = 1
myCol = Abs(c.Column - .Column)
If c.Column > .Column Then
myY = myCol * -2
Else
myY = myCol * 2
End If
c.Offset(, myY).Interior.ColorIndex = 3
Else
MsgBox "1行、または1列を選択してください"
Exit Sub
End If
End With
End Sub 'この行まで
※ まず最初のセル(起点のセル)を選択してマクロを実行してみてください。
※ 対象セルがSheet外の場合はエラーとなります。m(_ _)m
ご教授ありがとうございました。
基準セル・基準列がその都度指定できるのが,応用が利きそうでおもしろかったです。このコードをアレンジしてみたいと思いました。
また何かありましたらよろしくお願いいたします。
No.1
- 回答日時:
とりあえず、ヒントまで。
Sub Sample2()
Dim SelectRangeAddress As String
SelectRangeAddress = Selection.Address
Names.Add Name:="中心", RefersTo:="=" & SelectRangeAddress
End Sub
Sub Sample3()
Dim SelectRangeAddress As String
SelectRangeAddress = Selection.Address
Names.Add Name:="アクティブセル", RefersTo:="=" & SelectRangeAddress
End Sub
上記のものは、選択した位置に名前を定義するものです。
プログラムの流れとして、
1.セルを選択させるウィンドウを出す(対象の軸を選択してください。) ⇒きちんとした値が出るまで繰り返す
きちんとした値が入力されたら、色を塗る
2.セルを選択させるウィンドウを出す(対象の中心?を選択してください)⇒きちんとした値が出るまで繰り返す
きちんとした値が入力されたら、色を塗る
3.アクティブセルと軸?の対象位置を割り出す (Offsetとか色々算出方法はある?)
うーん、こんな流れですかねぇ…
せめて、対称位置の割り出し方法は考えてもらえませんか?
ご教授ありがとうございました。
OFFSETで対称位置を割り出してみたいと思います。
また何かありましたらよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルマクロでアニメを作る方法を教えてください。 1 2023/02/07 14:27
- Excel(エクセル) エクセルにおいてセル内の文字を出来るだけ大きく表示する方法を教えてください。 4 2022/07/30 08:08
- Visual Basic(VBA) エクセルのマクロコードの一部分を変更する方法について教えてください。 2 2023/02/17 08:40
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/21 09:28
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Excel(エクセル) 【Excel:条件付き書式 データバー】 正負の軸の位置を変更する方法を教えてください 3 2023/01/08 19:41
- Visual Basic(VBA) VBA初心者です。 VBAで行単位で条件付き書式の色をカウントしたいです。 大量のデータがあるExc 3 2022/06/08 10:00
- Visual Basic(VBA) VBA初心者です。 VBAで行単位で条件付き書式の色をカウントしたいです。 大量のデータがあるExc 3 2022/06/08 10:02
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/20 10:00
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル:セルの色のコード番...
-
vbaで指定したセルより下の行を...
-
IF関数で違う値もTRUEになる
-
結合されたセルの移動 VBA
-
Excelマクロ セルを行頭に移動
-
Excel VBA で色付きのセルの値...
-
マクロのデータ削除
-
ファイルサーバー上のexcelファ...
-
結合セル内の値を、結合解除後...
-
excel マクロでの特殊文字入力方法
-
(エクセルVBA)セルを左クリッ...
-
A1から最下行までを選択するVBA
-
VBA: ユーザー定義関数による、...
-
Excelでプルダウンからフィルタ...
-
エクセルでアクティブセルに対...
-
Excel VBA:フォーム←→セルのア...
-
Excelのマクロで、セルを結合し...
-
VBA Rangeの足し算
-
【VBA】アクティブセルだけ背景...
-
EXCEL VBA 文中の書式ごと複写...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
vbaで指定したセルより下の行を...
-
エクセルでセルをクリックする...
-
VBAでの SendKeysの変数指定方法
-
Excel VBA:フォーム←→セルのア...
-
Excelマクロ セルを行頭に移動
-
【VBA】アクティブセルだけ背景...
-
IF関数で違う値もTRUEになる
-
エクセルマクロで「セルのサイ...
-
Excel VBA で色付きのセルの値...
-
ダブルクリックでセルに色をつ...
-
excel マクロでの特殊文字入力方法
-
マクロのデータ削除
-
ExcelVBA コンボボックスに入力...
-
ファイルサーバー上のexcelファ...
-
VBA Rangeの足し算
-
(エクセルVBA)セルを左クリッ...
-
Excelのマクロで選択している行...
-
セルをクリックしたら色を変え...
-
エクセル:セルの色のコード番...
-
EXCEL(VBA) セルをクリックし...
おすすめ情報