Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Excel 2016)
Excel VBA 別の.xlsxブックに動的なドロップダウンリストを設定する
投稿日時: 20/01/16 14:36:40
投稿者: Yoshikun0928

Excel VBAについてお尋ねいたします。
整数を入力をするExcelファイル(拡張子:xlsx)の書式設定用の.xlsmファイルを作成いたしました。
 
.xlsmのVBAで書式設定を実施する.xlsxファイルを起動して、
先頭のワークシートで整数を入力するセル(2行目〜データがある最終行で、6列目・8列目・10列目)に動的なドロップダウンリストを設定したいです。
 
先頭のワークシートは左から
日付、届け先名称、商品名、入荷数量(4列目)、減算記号(−)、配達数量1(6列目)、減算記号(−)、配達数量2(8列目)、減算記号(−)、配達数量3(10列目)、減算記号(−)、残り数量(12列目)
となっております。
 
動的なドロップダウンリストにつきましては、処理の関係で、6列目・8列目・10列目の入力値の合計が4列目の整数以下となるように設定したいです。
 
例:入荷数量が40で配達数量1が40の場合は、配達数量2と配達数量3は0(1以上は入力不可)となり、
配達数量1が20の場合は、配達数量2・3で入力できる値の上限は20など入力値の合計が入荷数量を超過できないようにしたいです。
 
また、整数を入力するファイルは、入力する端末がマクロ非対応のため、拡張子を.xlsxとしており、整数を入力するファイルにマクロを書き込む(入力ファイルを.xlsmとして保存する)ことが出来かねます。
 
現在のコードがこちらです。

改変を容易にするため、標準モジュールに記載しています。
Option Explicit
Dim Row, Col, RMax, CMax, Cnt, Max, i As Integer
Public CellList() As Variant
Dim ListStr, Exf As String

Public Sub List()
  Cnt = 0 'カウント用変数を宣言し、初期値を格納する
  Exf = Dir(Path & "Q*.xlsx") '対象ファイルを取得する
  Do While Exf <> "" '対象ファイルがなくなるまで繰り返す
    If Ename(Cnt) = Exf Then '取得したファイル名と編集するファイル名が一致した場合
      If Cnt < 7 And De(Cnt + 11) = True Then
        On Error Resume Next
          Workbooks.Open Path & Exf '当該ファイルを開く
          Worksheets(1).Select '左から1番目のシートを選択
          Col = 1: Row = 1: CMax = 1: RMax = 1 '行番号 ・ 列番号の初期値を設定する
          CMax = Cells(1, 1).End(xlToRight).Column '右端の列番号を変数に格納する
          RMax = Cells(1, 1).End(xlDown).Row '下端の行番号を変数に格納する
          
          For Row = 2 To RMax '明細行の間繰り返す
            Max = Cells(Row, 4).Value '入庫数量を変数に格納する
            If Max > 40 Then '入庫数量が40超えの場合
              Max = 40 '最大値を40とする
            End If
            
            ReDim CellList(Max) '入力規則用配列を設定する
            For i = 0 To Max '入庫数量の間繰り返す
            CellList(i) = i '現在のカウント数値を配列に格納する
            Next
            ListStr = Join(CellList, ",") '入力リストを文字列化する
            For Col = 6 To 10 Step 2
              Cells(Row, Col).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=ListStr '入力規則を設定する
              Cells(Row, Col).Validation.ErrorTitle = "エラー" 'エラー発生時のタイトルを設定する
              Cells(Row, Col).Validation.ErrorMessage = "入荷数量以内で入力してください。" 'エラーメッセージを設定する
            Next
          Next
          
          Cells(1, 1).Select: ActiveWorkbook.Save 'A1セルに移動してここまでの作業を保存する
          Workbooks(Exf).Close 'Excelを終了する
        On Error GoTo 0
        
      End If
    End If
    Exf = Dir(): Cnt = Cnt + 1
  Loop
End Sub

記述方法がお分かりの方がいらっしゃいましたらご回答お願いいたします。[/code]

回答
投稿日時: 20/01/16 15:36:38
投稿者: WinArrow
投稿者のウェブサイトに移動

説明とコードの内容は、よくわかりませんが、
 
入力規則には、条件は指定できないので
 
条件ごとにドロップダウンリストを別のシートに作成&名前定義しておいて、
条件に対応した「名前」を指定していすればよいのでは?
 
 

リストの作成
(1)セルE1〜E20に1〜20を入力します。
(2)セルE1〜E10に「HANI10」という名前を定義します。
(3)セルE1〜E20に「HANI20」という名前を定義します。
 
入力規則の設定方法
 
A列セルの「値」を判断してB列セルに入力規則を設定する
セルAxが10以下のときは、「=HANI10」を元の値にセットする
セルAxが20以下のときは、「=HANI20」を元の値にセットする
 
こんな考え方でいかがでしょうか?

回答
投稿日時: 20/01/16 18:15:30
投稿者: mattuwan44

あっちで、セル範囲を可変で指定出来るという話をしたんだけど、
意図が通じなかったようですね。
 
今のやり方だと、
毎日ファイルをメンテナンスしてあげないとだめじゃないですか?
1回設定したら、終わりなようにしないと、
メンテナンスが大変すぎます。
 

Option Explicit

Sub Macro1()


Sub test()
    Dim wbk As Workbook
    Dim rngDatabody As Range
    
    Set wbk = ThisWorkbook
    
    With wbk.Worksheets(1).UsedRange
        Set rngDatabody = Intersect(.Cells, .Offset(1))
    End With
    
    ファイルに入力規則を追加 rngDatabody
End Sub

Sub ファイルに入力規則を追加(ByRef prngDatabody As Range)
    'リストに表示する値を次のシートに用意
    With prngDatabody.Worksheet.Next.Range("A1:A40")
        .Cells(1).Value = 1
        .DataSeries
        '.Worksheet.Visible = False     'シートを非表示に
    End With

    '入力規則のリストの設定
    With prngDatabody
        .Validation.Delete
        .Columns(6).Validation.Add Type:=xlValidateList, _
                                   Formula1:="=OFFSET(Sheet2!$A$1,0,0,$D2,1)"
        .Columns(8).Validation.Add Type:=xlValidateList, _
                                   Formula1:="=OFFSET(Sheet2!$A$1,0,0,$D2-$F2,1)"
        .Columns(10).Validation.Add Type:=xlValidateList, _
                                    Formula1:="=OFFSET(Sheet2!$A$1,0,0,$D2-$F2-$H2,1)"
    End With
End Sub

 
必要に応じて変更してください。
参考URL>>
https://iroiro-memo.hatenablog.com/entry/20140906/1410792047
 
あっちで長々書いたけど、まずは「手動で」出来るようになって、
それをマクロの記録でコード化するくらいは出来るようになって欲しかったです。

回答
投稿日時: 20/01/19 19:33:10
投稿者: simple

# 横入り失礼します。
マルチポストということですか?
https://teratail.com/questions/235329
ですね。
 
xlsファイルとは別に、xlsmファイルを作り、そのなかで、他のブックでも共通に動作する
イベントプロシージャを定義するという回答がありました。
それは今回の質問には関係しないのですか? 使えそうですが。
 
・入荷数量や、配達数量1~3等が入力されたタイミングで、
・未入力の項目について、
・入力可能数値を「残り数量」の範囲内にするという入力規則をセットする
という考え方でいいのですか?
 
 
ところで、今回質問者さんが提示されたコードですが、
  If Ename(Cnt) = Exf Then '取得したファイル名と編集するファイル名が一致した場合
      If Cnt < 7 And De(Cnt + 11) = True Then
といった、意味不明のものがあるのですが、これらは一体なんですか?
説明願いたい。

回答
投稿日時: 20/01/28 15:30:39
投稿者: takesi

マクロをほぞんできないとのことなので、別の簡易的な方法
 
条件付書式で 入荷量を超えたら赤く塗りつぶすとか。
 
=入荷数量-配達数量1-配達数量2-配達数量3<=0
 
入力したその場で割ると思います、いかがでしょうか。

回答
投稿日時: 20/01/29 00:22:44
投稿者: takesi

なんとか実用的にできたと思います。
 
  セル
  D2  数値(入荷数量)
  F2  数値(配達数量1)
  H2  数値(配達数量2)
  J2  数値(配達数量3)
 
  リストの値用に、AA2からAA101 に1から100の連番(必要な値まで伸ばしてください) 
  残在庫数用に AB2に 数式 =D2-F2-H2-J2 記入
 
  F2にデータ入力規則を設定
     種類;リスト
     元の値;=OFFSET($AA$2,0,0,$AB$2+F2,1)
  H2にデータ入力規則を設定
     種類;リスト
     元の値;=OFFSET($AA$2,0,0,$AB$2+H2,1)
  J2にデータ入力規則を設定
     種類;リスト
     元の値;=OFFSET($AA$2,0,0,$AB$2+J2,1)
 
検証
   F2、H2、J2のリストは最大D2の値まで
   F2、H2、J2に値が入ると、リストは最大(D2ーF2ーH2ーJ2の値までになる。
 
いかがでしょうか。

回答
投稿日時: 20/01/29 17:12:10
投稿者: takesi

なんどもすみません
入力規則がリストだと直接入力でのエラーチェックできないですね
整数を使用すると直接入力ですがエラーチェックできそうです。
 
しかし、既存のファイルに値がセットしてある場合入力規則を設定してもエラー出ない
入庫数量が40超えの場合40にする時点でエラーになることがある?
条件書式でエラー箇所が見やすくする ですかね。
 
Sub tes1()
 
    With ActiveSheet.Range("F2").Validation
        .Delete
        .Add Type:=xlValidateWholeNumber, _
             Operator:=xlBetween, Formula1:="1", Formula2:="=L2+F2"
        .ErrorMessage = "入荷数量以内で入力してください。"
    End With
    With ActiveSheet.Range("H2").Validation
        .Delete
        .Add Type:=xlValidateWholeNumber, _
             Operator:=xlBetween, Formula1:="1", Formula2:="=L2+H2"
        .ErrorMessage = "入荷数量以内で入力してください。"
    End With
    With ActiveSheet.Range("J2").Validation
        .Delete
        .Add Type:=xlValidateWholeNumber, _
             Operator:=xlBetween, Formula1:="1", Formula2:="=L2+J2"
        .ErrorMessage = "入荷数量以内で入力してください。"
    End With
    With Worksheets("Sheet2").Range("A2:L2")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$L$2<0"
        .FormatConditions(1).Interior.Color = vbRed
    End With
     
     
End Sub

トピックに返信