No.3ベストアンサー
- 回答日時:
シート名は「円を描く」にしてあります。
シート名を変えたい場合は、
Set ws = Worksheets("円を描く")
を変えてください。
円を描くマクロは、下記URLの内容をほぼそのまま利用しています。
https://infoment.hatenablog.com/entry/2018/07/01 …
以下のマクロを標準モジュールに登録してください。
Option Explicit
Public Sub 円を描く()
Dim ws As Worksheet
Dim wrow As Long
Dim wcol As Long
Dim maxrow As Long
Dim row_count As Long
Dim ng_count As Variant
Dim i As Long
Dim rg As Range
Dim sp As Shape
Set ws = Worksheets("円を描く")
maxrow = ws.Cells(Rows.count, "A").End(xlUp).Row '最大行取得
If maxrow < 2 Then Exit Sub
If maxrow Mod 2 <> 0 Then Exit Sub
row_count = maxrow \ 2
For Each sp In ws.Shapes
sp.Delete '図形を削除
Next
For i = 1 To row_count
wrow = (i - 1) * 2 + 2
ng_count = ws.Cells(wrow, 2).Value
Select Case ng_count
Case Is = ""
wcol = 3
Case Is < 1
wcol = 4
Case Is = 1
wcol = 5
Case 2, 3
wcol = 6
Case Is >= 4
wcol = 7
End Select
Set rg = ws.Range(ws.Cells(wrow, wcol), ws.Cells(wrow + 1, wcol))
Call MakeCircle(ws, rg)
Next
End Sub
Public Sub MakeCircle(ws As Worksheet, r As Range, Optional ρ As Double = 0.85, _
Optional myWeight As Double = 1.5)
Dim T As Double
Dim L As Double
Dim W As Double
Dim H As Double
Dim C As Shape
' 円の直径決定。セルの縦横を比較して、短い方を基準とする。
If r.Width >= r.Height Then
W = r.Height * ρ
Else
W = r.Width * ρ
End If
' 円のサイズと配置位置を決定。
H = W
T = r.Top + (r.Height - H) / 2
L = r.Left + (r.Width - W) / 2
' 円を描画。
Set C = ws.Shapes.AddShape(msoShapeOval, L, T, W, H)
C.Line.ForeColor.ObjectThemeColor = msoThemeColorText1
C.Fill.Visible = msoFalse
C.Line.Weight = myWeight
End Sub
No.4
- 回答日時:
こんばんは
ご自身で作成するつもりがあるのか、丸投げなのかよくわかりませんけれど・・
ご質問文にない部分は勝手に以下のように解釈しました。
・対象はB列の偶数行(2、4、6・・)に固定
・ただし、B列は空白の値もあるので、最終行はA列で判断する
・〇印は偶数行にあるセルの結合範囲とする
・〇印は「既定の書式」で描きますので、個別に設定したい場合は
追加してください。
同様に、仮定と異なる内容の部分については修正願います。
Sub Q_13208599()
Dim rw As Long, v As Long
Dim c As Range, L As Double
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 2
With Cells(rw, 2)
If IsNumeric(.Value) Then
v = Application.Min(.Value + 2 + (.Value > 2), 5)
If .Value = "" Then v = 1
Set c = .Offset(, v).MergeArea
L = Application.Min(c.Width, c.Height)
ActiveSheet.Shapes.AddShape msoShapeOval, _
c.Left + c.Width / 2 - L / 2, c.Top + c.Height / 2 - L / 2, L, L
End If
End With
Next rw
End Sub
No.1
- 回答日時:
記入者が入力した値がどういう場合に「優」、どういう場合に「良」、どういう場合に「可」なのかを具体的にします。
判定基準の具体化・定量化ですね。
それを日本語を使って明確にします。何らかのチャート図を知っている場合はそれを使って書くとビジュアル的にも確認出来て誤りや漏れなどを防ぐことが出来ます。
それが出来たらその処理手順をプログラム言語に翻訳します。
丸を入れる位置はセルの位置で示します。
参考まで。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) EXCEL関数(数式)を教えてください 11 2023/05/09 13:19
- Visual Basic(VBA) 複数セルに〇印をつけるマクロ 4 2022/09/07 05:33
- Excel(エクセル) ワードのマクロについて教えてください。 1 2023/03/11 13:50
- Excel(エクセル) 【!】Excel 2つの条件付き書式が反映されません。。 5 2023/07/14 16:47
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/21 09:28
- Visual Basic(VBA) Excel(VBA) 特定の条件に該当する行の値、書式を同じセルにコピ&ペーストしたいです 1 2022/05/21 18:18
- Excel(エクセル) Excelのマクロについて教えてください。 4 2022/05/31 14:07
- Excel(エクセル) 名前と日付が一致する箇所にフラグを立てる関数が知りたいです 4 2022/08/11 02:24
- Excel(エクセル) SUMIFのIF分岐について 4 2023/04/15 12:57
- Excel(エクセル) エクセル 3つの値の中からデータを抽出させる方法 4 2023/08/24 11:00
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
excelでSUBTOTAL関数を設定した...
-
エクセルで片方のセルに入力し...
-
エクセル ボタンを押すとセルの...
-
EXCELで、結合されたセルに連続...
-
セルを結合した場合の関数(COU...
-
エクセル 結合セル内に空白なら...
-
Excel 離れたセルへの連続デー...
-
VBAで結合したセルがクリアでき...
-
Excel ひとつのセルを分割する...
-
エクセルで作業した日の日付を残す
-
EXCEL VLOOKUP的コメント自動表示
-
Excel セルを結合したものを抽...
-
セルの値を取得してSQL文に組み...
-
Range("A1:A100")をセルから
-
エクセルでセルをクリックして“...
-
エクセルでチェックボックスを...
-
【EXCEL】条件に合致するセルの...
-
Excelで日数を計算したい。
-
Excelでnullになるような式のセ...
-
Excelのカウントアップボタンに...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
excelでSUBTOTAL関数を設定した...
-
エクセル ボタンを押すとセルの...
-
EXCELで、結合されたセルに連続...
-
セルを結合した場合の関数(COU...
-
エクセルで片方のセルに入力し...
-
VBAで結合したセルがクリアでき...
-
Excel 離れたセルへの連続デー...
-
セルの値を取得してSQL文に組み...
-
【EXCEL】条件に合致するセルの...
-
Excelでnullになるような式のセ...
-
エクセルで作業した日の日付を残す
-
エクセルでセルをクリックして“...
-
Excel セルを結合したものを抽...
-
Excelの表に自動でナンバリング...
-
VBAで困っています。
-
エクセルでたくさんのセルを小...
-
エクセル 結合セル内に空白なら...
-
EXCEL セル結合したセルを参照...
-
Excelのカウントアップボタンに...
-
エクセルでチェックボックスを...
おすすめ情報