回答編集履歴

1

コードの修正

2025/02/19 02:12

投稿

mattuwan
mattuwan

スコア2167

test CHANGED
@@ -1,64 +1,82 @@
1
1
  こんな感じかと。。。
2
2
 
3
- 標準モジュールにシート上のコントロールの記述をするのは、
4
- 結構面倒かも。
3
+ 標準モジュール
5
- あと、コントロールを挿入したり削除したりする意味もよくわかりませんね^^;
6
- それと、リストの作成はなんか数が合わないかもなんで、
7
- 微調整の必要ありです。
8
-
9
4
  ```ExcelVBA
10
5
  Option Explicit
11
6
 
12
7
  'コンボボックスの作成と初期化
13
8
  Sub ComboBox_Initialize()
9
+ Dim wsh As Worksheet: Set wsh = Worksheets("Sheet1")
10
+ Dim rngCmbBox As Range: Set rngCmbBox = wsh.Range("J1")
11
+ Dim rngReference As Range: Set rngReference = wsh.Range("L4:H122")
12
+
13
+ '既存のコンボボックスを削除
14
+ ComboAllDelete wsh
15
+ 'コンボボックスの作成
16
+ ComboCreate rngCmbBox, rngReference
17
+ End Sub
18
+
14
- Dim Wsh As Worksheet
19
+ Private Sub ComboAllDelete(ByRef pWsh As Worksheet)
15
- Dim Rng As Range
16
20
  Dim o As OLEObject
21
+
22
+ For Each o In pWsh.OLEObjects
23
+ If TypeName(o.Object) = "ComboBox" Then o.Delete
24
+ Next
25
+ End Sub
26
+
27
+ Private Sub ComboCreate(ByRef prngCmb As Range, _
28
+ ByRef prngRef As Range)
29
+ Dim cmb As MSForms.ComboBox
17
- Dim cmb As OLEObject
30
+ Dim c As Range
31
+ Dim i As Long, y As Long
32
+
33
+ With prngCmb
34
+ Set cmb = .Worksheet.OLEObjects.Add( _
35
+ ClassType:="Forms.ComboBox.1", _
36
+ Link:=False, DisplayAsIcon:=False, _
37
+ Left:=.Left, Top:=.Top, Width:=100, Height:=20).Object
38
+ End With
39
+ cmb.List = GetChoices(prngRef)
40
+ prngCmb.Value = prngRef.Address(External:=True)
41
+ End Sub
42
+
43
+ Private Function GetChoices(ByRef r As Range) As Variant
44
+ Dim vList() As Variant
45
+ Dim c As Range
18
46
  Dim i As Long
19
47
  Dim y As Long
20
48
  Dim m As Long
21
49
  Dim s As String
22
-
50
+ ReDim vList(0 To r.Count - 1) As Variant
23
- Set Wsh = Worksheets("Sheet1")
51
+ For i = LBound(vList) To UBound(vList)
52
+ y = Int(i / 12)
53
+ m = i Mod 12 + 1
54
+ If y = 0 Then
24
- Set Rng = Wsh.Range("J1")
55
+ s = m & "カ月目"
25
- Wsh.Unprotect
56
+ Else
26
- '既存のコンボボックスを削除
27
- For Each o In Wsh.OLEObjects
28
- If TypeName(o.Object) = "ComboBox" Then
57
+ s = y & "年" & m & "カ月目"
29
- o.Delete
30
58
  End If
59
+ vList(i) = s
31
60
  Next
61
+ GetChoices = vList
62
+ End Function
63
+ ```
32
64
 
65
+ シートモジュール
66
+ ```ExcelVBA
33
- 'コンボボックスの作成
67
+ Option Explicit
34
- Set cmb = Wsh.OLEObjects.Add( _
68
+
35
- ClassType:="Forms.ComboBox.1", _
69
+ Private Sub ComboBox1_Change()
36
- Link:=False, DisplayAsIcon:=False, _
37
- Left:=Rng.Left, Top:=Rng.Top, Width:=100, Height:=20)
38
-
39
- 'コンボボックスのリスト作成
40
- For y = 0 To 2
41
- For m = 1 To 12
42
- If m = 1 Then
43
- s = y & "" & m & "ヶ月"
70
+ SetUpdate Me.Range("H3:K3"), Me.ComboBox1
44
- Else
45
- s = m & "ヶ月"
46
- End If
47
- cmb.Object.AddItem s
48
- Next
49
- Next
50
71
  End Sub
51
72
 
73
+ Private Sub SetUpdate(ByRef ToRange As Range, _
74
+ ByRef cmb As MSForms.ComboBox)
75
+ Dim rngReference As Range
76
+ Set rngReference = Application.Range(Me.Range("J1").Value)
77
+ ToRange(1).Value = rngReference(cmb.ListIndex + 1, 1).Value
78
+ ToRange(2).Value = result
79
+ End Sub
80
+ ```
52
81
 
53
82
 
54
- 'セルの値を更新
55
- Sub UpdateCellValue(cmb As Object)
56
- Dim Wsh As Worksheet
57
- Dim Rng As Range
58
-
59
- Set Wsh = cmb.Parent
60
- Set Rng = Wsh.Range("H4:H122")
61
- Wsh.Range("K3").Value = Rng.Cells(cmb.ListIndex + 1).Address(False, False)
62
- End Sub
63
-
64
- ```