エクセルVBA ListBox選択を反映させる

このQ&Aのポイント
  • エクセルVBAのユーザーフォームにListBox1とListBox2があります。ListBox1とListBox2の選択内容に応じて、セルに値を入力する処理を作成しましたが、うまく動作しない問題があります。
  • 問題の内容として、以下の2点が挙げられます。まず、ListBox1の選択後にListBox2を選択しても実際には選択されていないように見えます。また、ListBox1とListBox2が1年違いまたは2年違いの場合にはセルに値が正しく入力されません。
  • 問題の解決策として、ListBox1の変更イベントのコードを修正し、ListBox2の選択を正しく反映するようにしましょう。また、ListBox1とListBox2が1年違いまたは2年違いの場合には適切な処理を行うように修正する必要があります。
回答を見る
  • ベストアンサー

エクセルVBA ListBox選択を反映させる

いろいろ試みたのですが、分からないので教えてください ・ユーザーフォームにListBox1、ListBox2があります ・やりたいこと ●ListBox1=ListBox2場合、A2にListBox1の値を入力 (ex)ListBox1がH8 (1996)、ListBox2がH8 (1996)の場合、A2に「H8」と入力 ●ListBox1がListBox2と1年違う場合、A2とA3にその間の期間を入力 (ex)ListBox1がH8 (1996)、ListBox2がH9 (1997)の場合、A2に「H8」、A3に「H9」と入力 ●ListBox1がListBox2と2年違う場合、A2とA4にその間の期間を入力 (ex)ListBox1がH8 (1996)、ListBox2がH10 (1998)の場合、A2に「H8」、A3に「H9」、A4に「H10」と入力 ・作成したもの1 Private Sub ListBox1_Change()     With ListBox2     .Clear     Select Case UserForm1.ListBox1.List(ListBox1.ListIndex)     Case "H8 (1996)"       .List = Array("H8 (1996)", "H9 (1997)", "H10 (1998)")     Case "H9 (1997)"       .List = Array("H9 (1997)", "H10 (1998)")     Case "H10 (1998)"       .List = Array("H10 (1998)")     End Select     .ListIndex = 0     End With End Sub ・作成したもの2 If Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) = Mid(ListBox2, Application.Find("(", ListBox2) + 1, 4) Then sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1988 End If If Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) + 1 = Mid(ListBox2, Application.Find("(", ListBox2) + 1, 4) Then sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1988 sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1987 End If If Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) + 2 = Mid(ListBox2, Application.Find("(", ListBox2) + 1, 4) Then sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1988 sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1987 sheets1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = "H" & Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) - 1986 End If ・困ったこと (1) ListBox1を選択した時、ListBox2の表示を切り替えられるようにしており、選択したように青になっていますが、実際はListBox2を選択していないようです ListBox1をH8にクリックしてから、ListBox2をH9やH10を選択して、再度H8を選択しなおさなければ、エラーになってしまいます (2)ListBox1とListBox2が1年違い、2年違いの場合、うまくいかずセルに入力されない もし分かる方がいらっしゃいましたら、教えてください よろしくお願いします

質問者が選んだベストアンサー

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.4

#1-3、cjです。#3お礼欄・補足欄へのレスです。 疑問点(1)については 補足欄に書かれた方法で十分対処可能と思います。 すべての記述を見て要求仕様を完全に理解できている訳ではないので、 私から断言はできませんが、その対策でうまく機能させることが出来ているのなら (つまり要求に沿う仕様が提供できているのなら) 方法的には間違いはありませんし、もっとも有力な方法だと思います。 疑問点(2)については IntegralHeightプロパティをデフォルトに戻すことが 唯一の正解ですから、間違いありません。 今後も細かいメンテナンスについての疑問について質問することがあるようでしたらば、 この課題については、モジュール全体を提示した方が、話は解り易いかと思います。 でも、#3お礼欄から補足欄での対処の仕方を見る限りでは、 十分に自力で解決に導く力をお持ちだなんだと思います。 頑張ってください。

kidibotkbg
質問者

お礼

細かく教えていただきありがとうございました

その他の回答 (3)

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.3

(直前の投稿の続きです。) 〓〓〓 > 自分が作成してきたものの訂正で、 > If Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) + 1 = _   Mid(ListBox2, Application.Find("(", ListBox2) + 1, 4) + 0 Then > と0を追加することで、1年違いや2年違いを反映させたい場合のエラーがなくなりました この記述が必要なものなのか、については次項で触れますが、 Application.Find....などと、わざわざExcelのワークシート関数を使って処理を遅くすることはないです。 VBAでは、文字列値の中から、特定の文字列を検索して位置を返す関数として、 InStr()関数が用意されています。 また、文字列値の先頭にある数字として読める部分だけを、数値として返す関数として、 Val()関数というのもあります。 強いて書くならば、ですが、 Select Case フレーズで、ListBox2とListBox1の年度の差を基準にして、   Select Case Val(Mid(ListBox2, InStr(ListBox2, "(") + 1)) - Val(Mid(ListBox1, InStr(ListBox1, "(") + 1))   Case 0    ' 単年 の場合の処理   Case 1    ' 1年違い の場合の処理   Case 2    ' 2年違い の場合の処理   ' ' 以下同様   End Select とか、 Val()関数の恩恵を強調するなら、   Select Case Val(Right(ListBox2, 5)) - Val(Right(ListBox1, 5))   Case 0    ' 単年 の場合の処理   Case 1    ' 1年違い の場合の処理   Case 2    ' 2年違い の場合の処理   ' ' 以下同様   End Select とか、 ListBoxのインデックスを調べて   Select Case (ListBox1.ListCount - ListBox1.ListIndex) - (ListBox2.ListCount - ListBox2.ListIndex)   Case 0    ' 単年 の場合の処理   Case 1    ' 1年違い の場合の処理   Case 2    ' 2年違い の場合の処理   ' ' 以下同様   End Select などのように書く方が、より基本に忠実っぽくなります。 〓〓〓 > ちなみに同じ年度を選択した場合は、解決していません こちらで書いたものを動作確認している限りでは、 > ●ListBox1=ListBox2場合、A2にListBox1の値を入力 > ●ListBox1がListBox2と1年違う場合、A2とA3にその間の期間を入力 > ●ListBox1がListBox2と2年違う場合、A2とA4にその間の期間を入力 という要件については問題なく実現されます。 例示が偶々そうなっているだけなのか、それとも、前提がそうなのか、もしかして、 「単年、1年違い、2年違い」=「1~3年間」→3年分より多くは扱わない、 というような限定があるのでしょうか? 仮にそうであったとしても、 ListBox1とListBox2の期間中の年度を列挙するということだけでしたら、 普通は、条件分岐ではなくて、For Next ループを使うものです。 説明されている以外の処理として、 期間が1年、期間が2年、の場合だけは何か特別な処理をしたい、ということならば、 別途、補足が必要です。 そういうことではなく、単にこちらが意図した対策が反映できない、ということでしたらば、 考えられる原因として、 Private flgDisEn As Boolean  '  ←★モジュールの宣言部に ! の(Userformモジュールの冒頭に書かれるべき)1行が抜けている、のではないでしょうか? 〓〓〓 > 年度 という言葉が出て来たので、念の為補足しておきますが、 上記「Private Sub UserForm_Initialize() に書き加える記述」のパラメータ指定、   ReDim arrList(1985 To Year(Date))  '  ←■要指定■ の部分は   ReDim arrList(1996 To 1998)  '  ←■要指定■ のように年度末に書き換えるように戻した方が好いかもです。 年度が変わる月日が解れば、対応可能ですけれど、それは、 今回の課題が片付いてから、余裕のある時に、ということで、、、。 〓〓〓 > (1)A列に期間を入力、B列に別の種類のデータを入力、C列に別の種類のデータを入力・・・ > (2)A列、B列、C列・・・すべてのデータの組み合わせをセルに反映させる > (3)AdvancedFilterでデータ抽出 (2)(3)については、お尋ねのテーマではありませんので、ここでは触れません。 何かあったら、別件でお尋ねください。 〓〓〓 既存の記述に書き加える時の注意としては、  処理を重複させない  処理の順番を把握して、必要な順に記述を配置する の2点だけ意識を高めてとりかかればいいです。 今回の場合は、こちらの記述で処理する部分、ListBox1とListBox2に関する処理 リストを書き換えたり、リストを選択する記述については、既存の記述をよく読んで、 削除するべきものは正しく削除して、処理が重複しないようにして下さい。 〓〓〓 以上です。 返信を急ぐ必要はまったくないですから、じっくり取り組んでください。 ちょっとしんどいかも、ですが、頑張って下さい。

kidibotkbg
質問者

お礼

返信が大変遅れて申し訳ありません 見よう見まねで作成してみました いくつか疑問点が出ましたので、もしお分かりでしたら教えてください (1) ListBox1を選択し→ListBox2を選択すればシート上に、ListBox1とListBox2の間の期間が反映されます しかし、ListBox1を選択し→ListBox2を選択せずにCommandButtonを実行すると、期間は反映されません ListBox2を選択していないのだから当たり前かもしれませんが、ListBox1とListBox2の値が同じ場合、わざわざ選択するのが面倒です そこでListBox1を選択した時点で、ListBox2も同じ値を自動的に選択するということはできるのでしょうか (ex)ListBox1で“H8(1996)”を選択した時点で、ListBox2も自動的に“H8(1996)”を選択させ、わざわざ自分でListBox2で“H8(1996)”を選択せずにCommandButtonをクリックしたら、シート状に“H8”を反映させる (2) 以前はListBox1とListBox2の縦の長さがプロパティのWidthは同じ値で、画面にも同じ長さで表示されていました 従来は以下のコードがPrivate Sub UserForm_Initialize()にありました With Me.ListBox1 .ColumnWidths = .Width - 3 End With With Me.ListBox1 .List = Array("H8 (1996)", "H9 (1997)", "H10 (1998)", "H11 (1999)", "H12 (2000)", "H13 (2001)", _ "H14 (2002)", "H15 (2003)", "H16 (2004)", "H17 (2005)", "H18 (2006)", "H19 (2007)", "H20 (2008)", _ "H21 (2009)", "H22 (2010)", "H23 (2011)", "H24 (2012)", "H25 (2013)") .ListIndex = 0 End With With Me.ListBox2 .ColumnWidths = .Width - 3 End With With Me.ListBox2 Me.ListBox2.ListIndex = 17 End With ところが、教えていただいたコードに変更していることが影響しているのか分からないのですが、プロパティのWidthは同じ値にもかかわらず画面では縦の長さがずれてしまいます 具体的にはListBox2を選択→ListBox1を選択すると、ListBox2の縦の長さが1行分短く表示させてしまいました もし解決方法をご存知でしたら教えてください よろしくお願いします

kidibotkbg
質問者

補足

触っているとうまくいけました (1) Private Sub ListBox1_Change() With ListBox2 .Clear .List = ListBox1.List For i = 0 To ListBox1.ListIndex - 1 .RemoveItem 0 Next i .ListIndex = 0 ←【追加】 End With 【追加】で先頭を選択させることで、うまくいきました (2) 縦幅が変更が変更してまうという不具合ですが、ListBoxのプロパティ→IntegralHeightを“False”にすることで解消しました 以上の訂正をしましたが、間違いでしたら指摘お願いします

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.2

#1、cjです。#1お礼欄へのレスです。 〓〓〓 > 具体的にはPrivate Sub UserForm_Initialize()で、ユーザーフォームの大きさなどを調整していたのですが、「名前が適切ではありません」と警告がでました 既存のPrivate Sub UserForm_Initialize()があるということなら、新たにPrivate Sub UserForm_Initialize()を併記することは出来ませんから、 既存のPrivate Sub UserForm_Initialize()の中に、新たな記述を配置してやればいいです。 (基本的なこととして、ひとつのモジュールに同じ名前のSubやFunctionを設定することは出来ませんので、既存のプロシージャに追記します。) 実物見ないと説明は難しいですけれど、 取り敢えず現在の記述の後(End Sub の前)に新たな記述を書き加える方向で、もちろん、ListBox1,ListBox2リスト設定の既存記述は削除します。 それでうまくいかない場合は、新たに書き加える記述が、どんな順番に書かれるべきか、目安を書いておきましたから、参考にして下さい。 【宣言部】と5つのセクション【sect1-5】に分けています。 ' ' ーー Private Sub UserForm_Initialize() に書き加える記述 ーーーー ' ' __________________________________ ' ' 【宣言部】同一変数名で宣言が重複しないように注意。   Dim arrList() As String   Dim i As Long ' ' __________________________________ ' ' 【sect1】sect2より前に書けば、どこでもいい。 ' ' List用配列(サイズとインデックスを定義) ' ' (開始年 To 終了年) を数値で指定する。(変数でも指定可。)   ReDim arrList(1985 To Year(Date))  '  ←■要指定■ ' ' __________________________________ ' ' 【sect2】sect4より前に書けば、どこでもいい。 ' ' List用配列   For i = LBound(arrList()) To UBound(arrList())     arrList(i) = Left$(Format(CDate(i & "/1/1"), "ge "), 3) & " (" & i & ")"   Next i ' ' __________________________________ ' ' 【sect3】sect4(LsitBoxのリスト操作)より前に書けば、どこでもいい ' ' Changeイベントをエスケープするイベント抑止フラグ   flgDisEn = True  '  ★ ' ' __________________________________ ' ' 【sect4】LsitBoxのリストを前提とした処理があるならば、それより前。   With ListBox1 ' ' 各ListBoxの.Listを設定     .List = arrList() ' ' Listの先頭を選択     .ListIndex = 0   End With   With ListBox2     .List = arrList() ' ' Listを選択しない!!  ▼   End With ' ' __________________________________ ' ' 【sect5】sect4(LsitBoxのリスト操作)より後に書けば、どこでもいい ' ' イベント抑止フラグを元に戻す   flgDisEn = False  '  ★ ' ' ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー 〓〓〓 > あと、B列のデータやC列のデータはCommandButtonをクリックすることで、セルにデータを反映させるようにしてたため、A列のみがListBoxを選択した時点で(CommandButtonをクリックする前から)反映されてしまいます それは至極真っ当なやり方です。ただ、それは最初に説明しておいて欲しかったですね。 対応は簡単です。 #1のPrivate Sub ListBox2_Change()を削除して、内容の一部を、改めて、 既存のPrivate Sub CommandButton1_Click() (CommandButtonの名前が違えばプロシージャ名も違いますが) の中に、配置してやればいいです。 【宣言部】と2つのセクション【sectA-B】に分けています。 ' ' ーー Private Sub CommandButton1_Click() に書き加える記述 ーーー ' ' __________________________________ ' ' 【宣言部】同一変数名で宣言が重複しないように注意。   Dim i As Long ' ' __________________________________ ' ' 【sectA】sectBより前に書けば、どこでもいい。 ' ' 出力先のセル値を空に   Range("A2:A30").ClearContents  '  ←■要指定■ ' ' __________________________________ ' ' 【sectB】LsitBoxのリストを前提とした処理があるならば、それより前。 ' ' ListBox2の先頭から選択位置まで"H#"(GE)をセルに出力   With ListBox2     For i = 0 To .ListIndex       Cells(i + 2, "A") = PickUpGE(.List(i, 0))     Next i   End With ' ' ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー 〓〓〓 尚、#1に掲載した、その他の記述について、 Private flgDisEn As Boolean  '  ←★モジュールの宣言部に ! Private Sub ListBox1_Change() Private Function PickUpGE(ByVal s As String) As String の3カ所はそのまま使います。 〓〓〓 > さらに、自分でリストを作成する場合は、H8(1996)の場合とH10(1998)とで和暦と西暦の間のスペース間隔を変えることで、和暦も西暦も左揃えのように見せていたので、それができなさそうですね(細かいことで、別に気にすることのほどではありませんが) 上記「Private Sub UserForm_Initialize() に書き加える記述」にて対策済です。     arrList(i) = Left$(Format(CDate(i & "/1/1"), "ge "), 3) & " (" & i & ")" 〓〓〓 (長くなったので、次の投稿に続けます。)

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.1

こんにちは。  ListBox1で開始(?)年を選択させて、   連動してListBox2のリストは開始(?)年以降だけのものに書き直して、  ListBox2で終了(?)年を選択させて、   連動して、開始(?)年から終了(?)年までの期間、一年毎の年号を   A2以下のセル範囲に連続して出力する という理解で合ってます? Userform 読み込み時、  ListBox1、ListBox2、共通で、指定期間の年号を、"GE (YYYY)"表示形式でリスト化 ListBox1_Change  ListBox2.List を ListBox1 で選択された年次以降のもののみに書き換え ListBox2_Change  選択期間の年号を連続で出力 既存のプロジェクトを手直しするには、 ご提示の記述を動かすことが出来ないこともあり(sheets1とか、改行とか、) もう少し全体を見てみないと何とも言えないです。 こちらで、サンプル書いてみましたので、試してみてください。 試す為の準備手順は3つ、  Userformを挿入  ListBoxを追加 * 2回  Userformモジュールに下記サンプルコードをコピペ だけですので、既存のプロジェクトに適用する前に、新規のブックで試した方が簡単です。 /// '  ←■要指定■ マークの行は、運用に合わせて指定してください。(仮に適当な指定をしています) '  ◆ マークの行は、Range、Cells、各一ヶ所、必要がならば、親シートを正しく指定してください。 '  ▼ マークの行は、現在抱えている問題の解決に対する直接的な手当てを示しています。            ListBox2の選択をコードからは一切指定しない、ということです。 '  ★ マークの行は、現在抱えている問題の解決にも関わることと思われますが、            併せて潜在的なトラブルの原因にも対策を加える意味もあります。 /// 既存のプロジェクトにどう反映させるか、というのは、 そちらで試行錯誤してみて貰ってからの相談、ってことになりそうです。 例えば、「ListBox2 が常に選択されていることを前提としたプロシージャ」が他に書かれていたとすれば、 それだけで、適応不可ってことになってしまいます。 サンプル自体は自己完結型で書いていますが、 そちらでの現在の問題点に対しては部分的な対処を仮想で示しているに過ぎません。 うまく応用できないようでしたら、補足してみてください。 必要なフィードバックがあり、十分に把握できる内容でしたら再レスします。 冒頭に書いたこちらの理解が、そもそも間違っていたりしたならば、ごめんなさい、です。 ' ' =====Userformモジュール=====  '  8378653 Option Explicit Private flgDisEn As Boolean  '  ←★モジュールの宣言部に ! ' ' /// Private Sub UserForm_Initialize()   Dim arrList() As String   Dim i As Long ' ' List用配列(サイズとインデックスを定義) ' ' (開始年 To 終了年) を数値で指定する。(変数でも指定可。)   ReDim arrList(1985 To Year(Date))  '  ←■要指定(年次期間)■ ' ' List用配列   For i = LBound(arrList()) To UBound(arrList())     arrList(i) = Format(CDate(i & "/1/1"), "ge") & " (" & i & ")"   Next i ' ' Changeイベントをエスケープするイベント抑止フラグ   flgDisEn = True  '  ★   With ListBox1 ' ' 各ListBoxの.Listを設定     .List = arrList() ' ' Listの先頭を選択     .ListIndex = 0   End With   With ListBox2     .List = arrList() ' ' Listを選択しない!!  ▼   End With ' ' イベント抑止フラグを元に戻す   flgDisEn = False  '  ★ End Sub ' ' /// Private Sub ListBox1_Change()   Dim i As Long ' ' イベント抑止フラグが立っている場合は、抜ける   If flgDisEn Then Exit Sub  '  ★ ' ' Changeイベント(の再帰呼び出し)をエスケープするイベント抑止フラグ   flgDisEn = True  '  ★   With ListBox2     .Clear  '  ▼一旦クリア ' ' 一旦、ListBox1.ListをListBox2にコピー     .List = ListBox1.List ' ' ListBox1で選択されている位置より前にあるリストをListBox2から消去     For i = 0 To ListBox1.ListIndex - 1       .RemoveItem 0     Next i ' ' Listを選択しない!!  ▼   End With ' ' イベント抑止フラグを元に戻す   flgDisEn = False  '  ★ End Sub ' ' /// Private Sub ListBox2_Change()   Dim i As Long ' ' イベント抑止フラグが立っている場合は、抜ける   If flgDisEn Then Exit Sub  '  ★ ' ' Changeイベント(の再帰呼び出し)をエスケープするイベント抑止フラグ   flgDisEn = True  '  ★ ' ' 出力先のセル値を空に   Range("A2:A30").ClearContents  '  ←■要指定(セル範囲)■  '  ◆シート指定? ' ' ListBox2の先頭から選択位置まで"H#"(GE)をセルに出力   With ListBox2     For i = 0 To .ListIndex       Cells(i + 2, "A") = PickUpGE(.List(i, 0))  '  ◆シート指定?     Next i   End With ' ' イベント抑止フラグを元に戻す   flgDisEn = False  '  ★ End Sub ' ' /// 文字列"GE (YYYY)" を引数として受け、先頭の"GE"(例:"H25")を文字列で返す関数。 Private Function PickUpGE(ByVal s As String) As String   Dim nPos As Long   nPos = InStr(s, "(") - 1   PickUpGE = Trim$(Left$(s, nPos)) End Function ' ' /// オマケ:文字列"GE (YYYY)" を引数として受け、Long型の数値として西暦を返す関数。 Private Function PickUpYYYY(ByVal s As String) As Long   Dim nPos As Long   nPos = InStr(s, "(") + 1   PickUpYYYY = Val(Mid$(s, nPos, Len(s) - nPos)) End Function ' ' ===================

kidibotkbg
質問者

お礼

回答ありがとうございます 試行錯誤していて返信送れてすみません (1) ListBox1で開始、ListBox2で終了を入力させ、その間の期間をセルに入力させるという考えでやっています なので、その理解で正しいです 補足しますと、CommandButtonをクリックすることで、 (1)A列に期間を入力、B列に別の種類のデータを入力、C列に別の種類のデータを入力・・・ (2)A列、B列、C列・・・すべてのデータの組み合わせをセルに反映させる AA列 AB列 AC列  A1   B1   C1  A1   B1   C2  A1   B2   C1  A1   B2   C2  A2   B1   C2  A2   B2   C2 といった流れ (3)AdvancedFilterでデータ抽出 というのが完成イメージです つまりは、データシートと検索条件を入力するシートがあり、ユーザーフォームで選択したキーワードに沿ってデータを抽出するものです 既に(3)AdvancedFilterコードは作成済みで、(1)でつまずいています (2) 作成していただいたコードをユーザーフォームに貼り付けするとうまくいきました 私のやり方では、年度が増えたときに、新たにリストを追加しなければならない等の煩わしさがあるので、教えていただいたやり方のほうが便利なんだと思います(理解して使えればということが前提ですが) ただ、あらかじめ自分で作成していたいくつかのコードが使えない警告が出ました 具体的にはPrivate Sub UserForm_Initialize()で、ユーザーフォームの大きさなどを調整していたのですが、「名前が適切ではありません」と警告がでました あと、B列のデータやC列のデータはCommandButtonをクリックすることで、セルにデータを反映させるようにしてたため、A列のみがListBoxを選択した時点で(CommandButtonをクリックする前から)反映されてしまいます さらに、自分でリストを作成する場合は、H8(1996)の場合とH10(1998)とで和暦と西暦の間のスペース間隔を変えることで、和暦も西暦も左揃えのように見せていたので、それができなさそうですね(細かいことで、別に気にすることのほどではありませんが) (3) 自分が作成してきたものの訂正で、 If Mid(ListBox1, Application.Find("(", ListBox1) + 1, 4) + 1 = _   Mid(ListBox2, Application.Find("(", ListBox2) + 1, 4) + 0 Then と0を追加することで、1年違いや2年違いを反映させたい場合のエラーがなくなりました ちなみに同じ年度を選択した場合は、解決していません よろしくお願いします

関連するQ&A

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • エクセルVBA 最終行にデータを追加する

    エクセルのユーザーフォームにチェックリストを用意しました CheckBox1~CheckBox5まであり、 CheckBox1をクリック(true)にすると、セルに“あ” CheckBox2をクリック(true)にすると、セルに“い” CheckBox3をクリック(true)にすると、セルに“う” CheckBox4をクリック(true)にすると、セルに“え” CheckBox5をクリック(true)にすると、セルに“お” を反映させようと思っています たとえば、 ・CheckBox1のみクリック(true)で、A1に“あ” ・CheckBox2のみクリック(true)で、A1に“い” ・CheckBox1、CheckBox3をクリック(true)で、A1に“あ”、A2に“う” ・CheckBox2~CheckBox5をクリック(true)で、A1に“い“、A2に“う“、A3に”え”、A4に“お” といった感じで、選んだチェック項目について、A列においてA1から次々とデータを入力しようとしています そこで、 sheets1.Range("A:A").Clear If CheckBox1.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "あ" End If If CheckBox2.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "い" End If If CheckBox3.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "う" End If If CheckBox4.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "え" End If If CheckBox5.Value = True Then sheets1.Cells(Rows.Count, 1).End(xlUp) = "お" End If としました (実際は、CheckBoxの名前が1~5と数字ではないので、forは使いませんでした) すると、 CheckBox1~CheckBox5を全てクリック(true)しても、A1に“お”が反映されるだけで“あ”~”え”が入力されません どうすれば、思い通りになるのでしょうか 初歩的な質問だと思うのですが、よろしくお願いします

  • エクセル VBA マクロについて

    VBA初心者です。 Sub 記入() Range("H8", "J14").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H15", "J21").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("H22", "J28").Copy Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Range("K13").Select End Sub こういうマクロを作り上手く作動しましたのでB列に日付を記入したいと思い Sub 日付() Range("("B" & Rows.Count).End(xlUp).Offset(1)","("C" & Rows.Count).End(xlUp).Offset(0, -1)").Value = Date End Sub このようなマクロを組みましたがエラーがでます。どなたか直して頂けませんか?よろしくお願いします。

  • エクセルVBA 二回目の処理でエラーが。。

    お世話になります。 今回は下記のコードですが、一回目の処理は実行されますが 二回目になるとエラーになります。 Findが悪さしているのは分かっているのですが、解決方法が分かりません。 宜しくお願い致します。 '// 非対象相手先にチェックを付ける作業 With Sheets("非対象") For Each CRR In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) If CRR = TG Then Serc = .Cells(CRR.Row, 2) Cells(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Find(Serc).Row, 36) = 0 End If Next End With 変数の宣言はちゃんと出来てます。 一回目のForではエラーも出る事なく実行されます。 しかし、二回目ではWithが設定されてない的なエラー表示がされます。

  • エクセルVBA 対比表を作りたいです。

    お世話になります。混乱を極めてしまったので、質問させて頂きます。 下記の様なリストがあります。 A列  B列 No  相手 1   1 1   2 1   3 1   5 2   1 2   2 3   2 3   3 3   4 ・  ・ ・  ・ ・ 以下、数百まであります。 上記で 「1-2」と「2-1」はありますが、「1-3」はあるけど「3-1」がありません。 (その他「1-5」無いなどです。上記は一例としてます。) この場合「1-3」の部分の「1」を「0」などに置き換えたいのですが、下記コードを 書きましたが、上手く目的の結果にたどり着けない状態になっております。 (同じ部分を検索しているだけになってしまっていて。。。) 下記はユーザーフォームからのコードになりますので、ListBoxの記載ありますが、 選択されているListBoxの値で非一致を探すって形にしようとしております。 For Each KRR In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) If KRR = ListBox1.List(ListBox1.ListIndex, 0) Then SDF = Cells(KRR.Row, 2) For Each SRR In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row) If Cells(SRR.Row, 1) = SDF Then SSDF = 1 End If Next If SSDF <> 1 Then Cells(KRR.Row, 1) = 0 End If SSDF = 0 End If Next 要するにA列とB列を反対にした状態で、一致する値が無い場合は、対象CellのA列に「0」を 代入したいって事を考えております。 完全に混乱してしまっているので、お助け下さい。。。

  • エクセルVBA の変数を使うべきでしょうか?

    はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If   ・     ・   ・     ・   ・     ・ End Sub

  • <excel:VBA>変数を使って簡略化したい

    google検索してなんとか自力で作ったVBAを下記に貼りました。 きちんと動作はするのですが、せっかくなので変数を使って簡素化し、 データが多くても動作が速くなるようにしたいのです。 いろいろ試しましたが、変数の使い方の知識が乏しく、うまくいきませんでした。 変数としたいのは■マークの2箇所になると思います。 詳しい方、力を貸していただけないでしょうか。 どうぞよろしくお願いいたします。 ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Sub オートフィルタ貼付作業() With Sheets("データ").Range("A3") Application.ScreenUpdating = False Range("AA3:EK3").AutoFilter .AutoFilter Field:=1, Criteria1:="1" ’■Fieldが1ずつ増えていく Range("AA3").Copy Range("Z3") ’■AA3が1列ずつ右へずれていく .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter Range("AA3:EK3").AutoFilter .AutoFilter Field:=2, Criteria1:="1" Range("AB3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter ~~~~~~~~~~~~ 115列分のデータがあり 下記まで同じようにつづきます ~~~~~~~~~~~~ Range("AA3:EK3").AutoFilter .AutoFilter Field:=115, Criteria1:="1" Range("ek3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter End With Application.ScreenUpdating = True Sheets("貼付").Activate Cells.Columns.AutoFit End Sub ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

  • マクロ 行を切り取ってペーストでエラーになる

    J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか? 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i

  • VBA作製ができません。どなたか教えてください。

    前回同じタイトルで質問させていただいた物を自分なりに本で調べて 作ってみました。しかし壁にぶつかりました。 Cells(Rows.Count, 7).End(xlUp).Offset(rowoffset:=1).Select この式は7列目の一番下の空欄のセルを選択できる式のようですが、 指定した範囲のなかで7列目の一番下のセルを選択したいのですがどうすればいいでしょうか? つまり列だけじゃなく行も選択したいです。 教えてください。 こんな式を作りました。  もし式を簡単に効率よくできる方法があればアドバイス下さい。 If Range("G4").Value = SpecialCells Then Range("H4").Select Else Range("G4").Select Range("G4").Copy Windows("Book1.xlsx").Activate Range("G18:G26") = Selection.Areas.Count Cells(Rows.Count, 7).End(xlUp).Offset(rowoffset:=1).Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Book2.xlsm").Activate Range("D4").Select Range("D4").Copy Windows("Book1.xlsx").Activate Cells(Rows.Count, 4).End(xlUp).Offset(rowoffset:=1).Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Book2.xlsm").Activate Range("E4").Select Range("E4").Copy Windows("Book1.xlsx").Activate Cells(Rows.Count, 5).End(xlUp).Offset(rowoffset:=1).Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Book2.xlsm").Activate Range("H4").Select End If

  • VBA 高速化

    以下のコードを改良して早く処理できるようにしたいです。素因数分解をして、素因数の数を数えるプログラムです。 Sub 素因数を数える() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim I As Long, j As Long, cnt As Long, wS As Worksheet, k As Long, Set wS = Worksheets("Sheet2") k = Worksheets("Sheet1").Range("A100010").End(xlUp).Row - 1 For dd = 3 To k Call aaa(Range("A" & dd)) Next dd Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub aaa(ByVal Target As Range) Set wS = Worksheets("Sheet2") If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If Not IsNumeric(.Value) Then Exit Sub If .Value Mod 1 = 0 Then Range("D1") = .Value For I = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row Do While Cells(Rows.Count, "D").End(xlUp) Mod wS.Cells(I, 1) = 0 cnt = cnt + 1 Cells(Rows.Count, "D").End(xlUp).Offset(1) = Cells(Rows.Count, "D").End(xlUp) / wS.Cells(I, 1) Loop If Cells(Rows.Count, "D").End(xlUp) = 1 Then Exit For Next I End If .Offset(, 1) = cnt End With Range("D:D").Clear End Sub 以前教えていただいたコードを使って書きました。 どういう状況で使っているかといいますと、シート1のA列に自然数を2から順番に並べ、シート2のA列に素数を並べておき、プログラムを実行すると、B列に素数の数が表示されるという具合です。 大変役に立っていたのですが、10萬ほどのデータを扱おうとすると、自分のコンピュータでは時間がかかりすぎます。そこでコードを改良して高速化をしたいのです。 いま考えられる改良点は、 1、D列を使って行っている処理をメモリで行うようにして、セルへのアクセスを省けないか 2、aaaの5行目の、"wS.Cells(Rows.Count, "A").End(xlUp).Row"この処理を簡単な変数の処理で代用できないか ということです。他にも高速化できる方法があれば教えてください。 よろしくお願いします。

専門家に質問してみよう