前提・実現したいこと
閲覧ありがとうございます。
現在Excel2010を使用し、入力フォームを作成しています。
そこでVBAを使用し、入力フォームを作成しました。
入力フォームから入力したデータを使用し、マップを作成しようと考えています。
必要な項目はコンボボックスで作成し、Start・Endはテキストボックスで作成し、入力してもらう。
出力結果は以下のように列持ちのデータにします。
Year・Start・Endはそれぞれ2017年・2018年・2021年・2024年となります。
画像のような形のマップを作成したいと思っています。
行いたい処理
・列持ちのデータからStartとEndのデータを取得し、差分を計算し長方形を作成。
・長方形の中に季節のデータを表示させ、適用or未適用が適用であれば色を塗りつぶす。未適用なら
塗りつぶさない。
・図のように一番下にはStartとEndのデータが表示される。
・種類が異なれば次の行に長方形を表示させるような形です。
|地域|地方|果物|種類|季節|適用or未適用|Year|Start|End
|:--|:--:|--:|
|日本|関東|りんご|おいらせ|秋|適用|17|18|21|
|日本|関東|りんご|おいらせ|春|適用|20|21|24|
|日本|関東|りんご|あかぎ|秋|未適用|20|21|24|
発生している問題・エラーメッセージ
入力したデータから長方形を作成したい。 ※StartとEndの数値から長さを求め、その長さで長方形を作成する。 ネットで調べた限りそのような情報が見当たりませんでした。
該当のソースコード
VBA
1Option Explicit 2Private lastRow As Long 3 4 5'ユーザーフォームの説明(Text形式のデータ以外・入力もできるようコンボボックス) 6Private Sub UserForm_Initialize() 7 'コンボボックスで地域を選択させる 8 cmbArea.Style = fmStyleDropDownCombo 9 cmbArea.RowSource = "" 10 cmbArea.Clear 11 cmbArea.AddItem "インド" 12 cmbArea.AddItem "インドネシア" 13 cmbArea.AddItem "タイ" 14 cmbArea.AddItem "ブラジル" 15 cmbArea.AddItem "マレーシア" 16 cmbArea.AddItem "欧州" 17 cmbArea.AddItem "中国" 18 cmbArea.AddItem "日本" 19 cmbArea.AddItem "北米" 20 cmbArea.ListIndex = -1 21 22 'コンボボックスで地方を選択させる 23 cmbRegion.Style = fmStyleDropDownCombo 24 cmbRegion.RowSource = "" 25 cmbRegion.Clear 26 cmbRegion.AddItem "関東" 27 cmbRegion.AddItem "ジョージア州" 28 cmbRegion.ListIndex = -1 29 30 'コンボボックスで果物を選択させる 31 cmbFruit.Style = fmStyleDropDownCombo 32 cmbFruit.RowSource = "" 33 cmbFruit.Clear 34 cmbFruit.AddItem "りんご" 35 cmbFruit.AddItem "みかん" 36 cmbFruit.ListIndex = -1 37 38 'コンボボックスで種類を選択させる 39 cmbType.Style = fmStyleDropDownCombo 40 cmbType.RowSource = "" 41 cmbType.Clear 42 cmbType.AddItem "温州" 43 cmbType.AddItem "おいらせ" 44 cmbType.ListIndex = -1 45 46 'コンボボックスで季節を選択させる 47 cmbSeason.Style = fmStyleDropDownCombo 48 cmbSeason.RowSource = "" 49 cmbSeason.Clear 50 cmbSeason.AddItem "春" 51 cmbSeason.AddItem "秋" 52 cmbSeason.ListIndex = -1 53 54 'コンボボックスで適用or未適用を選択させる 55 cmbApplication.Style = fmStyleDropDownCombo 56 cmbApplication.RowSource = "" 57 cmbApplication.Clear 58 cmbApplication.AddItem "適用" 59 cmbApplication.AddItem "未適用" 60 cmbApplication.ListIndex = -1 61 62 63End Sub 64 65Private Sub cmdToroku_Click() 66 '各項目で未入力または未選択がある場合、再入力を促す 67 If cmbArea.Text = "" Then 68 MsgBox "地域を入力してください" 69 Exit Sub 70 End If 71 72 If cmbRegion.Text = "" Then 73 MsgBox "地方を入力してください" 74 Exit Sub 75 End If 76 77 If cmbFruit.Text = "" Then 78 MsgBox "果物を入力してください" 79 Exit Sub 80 End If 81 82 If cmbType.Text = "" Then 83 MsgBox "種類を入力してください" 84 Exit Sub 85 End If 86 87 If cmbSeason.Text = "" Then 88 MsgBox "季節を入力してください" 89 Exit Sub 90 End If 91 92 If cmbApplication.Text = "" Then 93 MsgBox "適用or未適用を入力してください" 94 Exit Sub 95 End If 96 97 If txtYear.Text = "" Then 98 MsgBox "MYを入力してください" 99 Exit Sub 100 End If 101 102 If txtStart.Text = "" Then 103 MsgBox "startを入力してください" 104 Exit Sub 105 End If 106 107 If txtEnd.Text = "" Then 108 MsgBox "endを入力してください" 109 Exit Sub 110 End If 111 112 '全ての項目が入っているとき、Sheet1のワークシートに対して最後の行の次の行にデータを格納していく 113 With Worksheets("Sheet1") 114 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 115 .Cells(lastRow, 1).Value = cmbArea.Text 116 .Cells(lastRow, 2).Value = cmbRegion.Text 117 .Cells(lastRow, 3).Value = cmbFruit.Text 118 .Cells(lastRow, 4).Value = cmbType.Text 119 .Cells(lastRow, 5![イメージ説明](ea70f9b2ae82dbed878e51c1a1e58f9a.jpeg)e = cmbType.Text 120 .Cells(lastRow, 6).Value = cmbApplication.Text 121 .Cells(lastRow, 7).Value = txtYear.Text 122 .Cells(lastRow, 8).Value = txtStart.Text 123 .Cells(lastRow, 9).Value = txtEnd.Text 124 End With 125 126 '入力項目のリセット(項目のデフォルト設定も行える) 127 cmbArea.Text = "" 128 cmbRegion.Text = "" 129 cmbFruit.Text = "" 130 cmbType.Text = "" 131 cmbSeason.Text = "" 132 cmbApplication.Text = "" 133 txtMy.Text = "" 134 txtStart.Text = "" 135 txtEnd.Text = "" 136 137End Sub 138
試したこと
補足情報(FW/ツールのバージョンなど)
内容が複雑なのとVBAでできるかどうかの判断がつきませんが、ご回答をお願いいたします。
回答3件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/03/07 03:27 編集
2018/03/07 04:25 編集
2018/03/07 09:31 編集
2018/03/07 11:22 編集
2018/03/08 03:10 編集
2018/03/08 03:43
2018/03/09 05:35
2018/03/09 06:03
2018/03/12 01:18
2018/03/12 06:25