0

指定されたセルにデータ検証リストを作成するマクロをExcelVBAで作成しています。次に、プログラムは、データ検証リストの内容を含むセルの入力をユーザーに求めます。リストの内容を含む同じ行は、ビューから非表示になります。ただし、マクロを複数回再実行しようとすると、コンテンツの新しい範囲を選択するたびに、各手順リストがこの範囲を参照します。 私はこれが起こらないようにしたい。

これを防ぐために、次のコード行を作成しました。

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

ここで、strRngは、データ検証に追加するときに参照する範囲の名前です。ただし、何らかの理由でこれは機能しません。リストに追加する範囲ごとに独立した名前が作成されるため、これでうまくいくと思いました。しかし、そうではありません...

コード全体は次のとおりです。

Sub CreatDropDownList()
Dim strRange As String
Dim celNm As Range
Dim celNm2 As Range 'use only if necessary
Dim celRng As Range
Dim strRngNumLbl As Integer
Dim nm As Name


On Error GoTo pressedCancel:

Set celNm = Application.InputBox(Prompt:= _
                "Please select a cell to create a list.", _
                   Title:="SPECIFY Cell", Type:=8)

If celNm Is Nothing Then Exit Sub

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?


'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

'cell range equal to nothing
Set celRng = Nothing

'asks user to determine range of strings
Set celRng = Application.InputBox(Prompt:= _
    "Please select the range of cells to be included in list.", _
        Title:="SPECIFY RANGE", Type:=8)

If celRng Is Nothing Then Exit Sub
On Error GoTo 0

strRange = "DataRange"
strRngNumLbl = 1

'Increments strRngNumLblb for the number of names present in the workbook to
'ensure list is not referring to duplicate ranges
For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm
strRange = strRange & strRngNumLbl

'user defined data range is now called strRange, refer to it as Range(strRange)
ThisWorkbook.Names.Add Name:=strRange, RefersTo:=celRng

'format the refernce name for use in Validation.add
strRange = "=" & strRange

celNm.Offset(-1, 0).Select

'Add the drop down list to the target range using the list range
celNm.Validation.Delete
celNm.Validation.Add xlValidateList, , , strRange

'hide the range where the list came from
celRng.EntireRow.Hidden = True

pressedCancel:
End Sub

助言がありますか？

4

2 に答える 2

1

問題を解決する

それ以外の：

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNmLbl + 1
Next nm

あなたが持っている必要があります：

strRngNumLbl = ThisWorkbook.Names.Count + 1

コードに関するヒントや質問

コードのこの部分の使用法がわかりません。

'Inserts a copy of the row where the drop down list is going to be
celNm.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert '?

'moves the cell to the appropriate location
celNm.Offset(0, -1).Value = "N/A"

この部分もわかりません。さらに、ユーザーが列Aのセルを選択すると、エラーが発生する可能性があります。

celNm.Offset(0, -1).Value = "N/A"

お役に立てば幸いです。

于 2011-07-29T08:21:00.037 に答える
1

strRange名がすでにThisWorkbook.namesにあるかどうかを確認するだけで、この問題を解決できました。上記のコードの編集は次のとおりです。

For Each nm In ThisWorkbook.Names
    strRngNumLbl = strRngNumLbl + 1
    strRange = strRange & strRngNumLbl
    If strRange = nm Then
        strRngNumLbl = strRngNumLbl + 1
        strRange = strRange & strRngNumLbl
    End If
Next nm
于 2011-08-02T16:14:05.577 に答える