excelの入力条件付きドロップダウンリストのマクロの件では

SALINGER様、kn1967様に大変お世話になっております。
http://q.hatena.ne.jp/1261024573
先日教授戴きましたマクロを更に改造して以下の様な
ことをexcelマクロで出来るでしょうか?
セルA1~A5に入力する方法はドロップダウンリスト
リストデータ(例)は、セルC1~C6の値(100,85,70,55,40,25)
・入力順番は、A1→A2…A5固定
・リストデータの最小値を入力したセル(EX.A3)以降のセル(EX.A4、A5)では、
自動的に " ― "(又は空白)が入力され、ドロップダウンリスト表示は出なくなる。
・A1~A5の任意にセル上で、マウスの右ボタンを押すと、入力した内容を変更しますか?等
のメッセージを表示し、Yes/No分岐。
yesを選択したときは、A1~A5を自動的にクリアして、ドロップダウンリストがA1に復活し、
A1~A5の入力が可能になる。
ご教授宜しくお願い申し上げます。


回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2009/12/22 10:48:05
  • 終了:2009/12/29 10:50:03

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/12/22 17:21:09

ポイント27pt

①と②の変更です。

コードの先頭で入力セルとリストセル範囲を指定できるようにしました。


Const strARange As String = "A1:A5"     '入力セル
Const strCRange As String = "C1:C6"     'リストセル

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Cancel = True
    If MsgBox("入力した内容を変更しますか?", vbYesNo + vbQuestion) = vbYes Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect Password:="1234"
        With ARange
            .Locked = False
            .Validation.Delete
            .ClearContents
        End With
        
        With Cells(ARange.Row, ARange.Column).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=dList(Application.WorksheetFunction.Max(CRange) + 1)
            ActiveSheet.Protect
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
        Application.EnableEvents = True
    End If
End Sub

Private Function dList(j As Double) As String
    Dim s As String
    Dim r As Range
    For Each r In Range(strCRange)
        If j > r.Value Then
            s = s & "," & r.Value
        End If
    Next
    dList = s
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Dim s As String
    Dim num As Double
    Dim r As Range
    
    num = Application.WorksheetFunction.Min(CRange)
    
    If Target.Row < ARange.Row + ARange.Count - 1 Then
        If Target.Value = num Or Target.Value = "-" Then
            Target.Offset(1, 0).Value = "-"
        Else
            s = dList(Target.Value)
            If s = "" Then
                Target.Offset(1, 0).Value = "-"
            Else
                Target.Offset(1, 0).Validation.Delete
                With Target.Offset(1, 0).Validation
                    ActiveSheet.Unprotect Password:="1234"
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=s
                    ActiveSheet.Protect
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .IMEMode = xlIMEModeNoControl
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
    Target.Validation.Delete
End Sub

③の文字列の場合です。

Const strARange As String = "A1:A6"     '入力セル
Const strCRange As String = "D1:D5"     'リストセル

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ARange As Range
    Dim CRange As Range
    Dim s As String
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Cancel = True
    If MsgBox("入力した内容を変更しますか?", vbYesNo + vbQuestion) = vbYes Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect Password:="1234"
        With ARange
            .Locked = False
            .Validation.Delete
            .ClearContents
        End With
        
        s = dList()
        If s <> "" Then
            With Cells(ARange.Row, ARange.Column).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=dList()
                ActiveSheet.Protect
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = True
            End With
        Else
            MsgBox "リストが設定されていません"
        End If
        Application.EnableEvents = True
    End If
End Sub

Private Function dList() As String
    Dim s As String
    Dim r As Range
    For Each r In Range(strCRange)
        If Range(strARange).Find(r.Value, lookat:=xlWhole) Is Nothing Then
            s = s & "," & r.Value
        End If
    Next
    dList = s
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Dim s As String
    Dim r As Range
    
    If Target.Row < ARange.Row + ARange.Count - 1 Then
        If Target.Value = "-" Then
            Target.Offset(1, 0).Value = "-"
        Else
            s = dList()
            If s = "" Then
                Target.Offset(1, 0).Value = "-"
            Else
                Target.Offset(1, 0).Validation.Delete
                With Target.Offset(1, 0).Validation
                    ActiveSheet.Unprotect Password:="1234"
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=s
                    ActiveSheet.Protect
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .IMEMode = xlIMEModeNoControl
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
    Target.Validation.Delete
End Sub

※コード中エラーで止まった後、右クリックしてもメッセージボックスがでない場合、

一時的にイベントが起こらなくなっている可能性があります。

そのときはイミディエイトウィンドウに以下を入力してエンターを押してください。

Application.EnableEvents =True

id:kn1967 さんのコードを参考にさせて頂きました。ありがとうございました。

http://q.hatena.ne.jp/

id:hawk007

SALINGER 様

いつもお世話になっております。

コードの先頭で入力セルとリストセル範囲を指定

できるようにして頂き、大変移植が容易になりました。

ありがとうございます。

2009/12/25 08:41:50

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/12/22 11:38:01

ポイント27pt

A1→A5固定ということで、ドロップダウンリストが表示されるのは入力するセルだけとしました。

一番最初はA1にドロップダウンリストは表示されていないので、右クリックではいを選択してください。


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub
    Cancel = True
    If MsgBox("入力した内容を変更しますか?", vbYesNo + vbQuestion) = vbYes Then
        Application.EnableEvents = False
        With Range("A1:A5")
            .Validation.Delete
            .Clear
        End With
        
        With Range("A1").Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=dList(1000)        '最大よりも大きい数字
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    Application.EnableEvents = True
    End If
End Sub

Private Function dList(j As Integer) As String
    Dim i As Integer
    Dim s As String
    
    For i = 1 To 6
        If j > Cells(i, "C").Value Then
            s = s & "," & Cells(i, "C").Value
        End If
    Next i
    dList = s
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub
    Dim i As Integer
    Dim j As Integer
    Dim s As String
    Dim num As Integer
    
    num = Cells(1, "C").Value
    For i = 2 To 6
        If Cells(i, "C").Value < num Then
            num = Cells(i, "C").Value
        End If
    Next i
    
    If Target.Row < 5 Then
        If Target.Value = num Or Target.Value = "-" Then
            Target.Offset(1, 0).Value = "-"
        Else
            Target.Offset(1, 0).Validation.Delete
            With Target.Offset(1, 0).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=dList(Target.Value)
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
    Target.Validation.Delete
End Sub

http://q.hatena.ne.jp/

id:hawk007

SALINGER 様

いつもお世話になっております。

ありがとうございます

①例えば、A1~A5の入力位置を

A15~A19に変更する場合は、

Range("A1:A5")のところをA15:A19にして

If Target.Row < 5 Thenのところの5を19にすればよいのでしょうか?

②C1~C6の値を50.0,25.0,10.0,5.0,2.5,1.25とした場合、プルダウンリストで1.25

を選択すると実行しエラー”1004"が発生してしまうのですが、回避は可能でしょうか?

③C1~C6の値を50.0,25.0,10.0,5.0,2.5,1.25を数値ではなく、文字列として

 A1~A5の文字列として表示させることは可能でしょうか?

④このマクロで使用するセルと別途セル単位でロックしない設定をしたセル以外と数式があるセルは保護をかけたい

 のですけれど

ActiveSheet.Unprotect Password:="1234”

ActiveSheet.Protectはどこの仕掛ければよいでしょうか?

ご教授よろしくお願い申し上げます。

2009/12/22 14:57:37
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/12/22 17:21:09ここでベストアンサー

ポイント27pt

①と②の変更です。

コードの先頭で入力セルとリストセル範囲を指定できるようにしました。


Const strARange As String = "A1:A5"     '入力セル
Const strCRange As String = "C1:C6"     'リストセル

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Cancel = True
    If MsgBox("入力した内容を変更しますか?", vbYesNo + vbQuestion) = vbYes Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect Password:="1234"
        With ARange
            .Locked = False
            .Validation.Delete
            .ClearContents
        End With
        
        With Cells(ARange.Row, ARange.Column).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=dList(Application.WorksheetFunction.Max(CRange) + 1)
            ActiveSheet.Protect
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
        Application.EnableEvents = True
    End If
End Sub

Private Function dList(j As Double) As String
    Dim s As String
    Dim r As Range
    For Each r In Range(strCRange)
        If j > r.Value Then
            s = s & "," & r.Value
        End If
    Next
    dList = s
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Dim s As String
    Dim num As Double
    Dim r As Range
    
    num = Application.WorksheetFunction.Min(CRange)
    
    If Target.Row < ARange.Row + ARange.Count - 1 Then
        If Target.Value = num Or Target.Value = "-" Then
            Target.Offset(1, 0).Value = "-"
        Else
            s = dList(Target.Value)
            If s = "" Then
                Target.Offset(1, 0).Value = "-"
            Else
                Target.Offset(1, 0).Validation.Delete
                With Target.Offset(1, 0).Validation
                    ActiveSheet.Unprotect Password:="1234"
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=s
                    ActiveSheet.Protect
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .IMEMode = xlIMEModeNoControl
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
    Target.Validation.Delete
End Sub

③の文字列の場合です。

Const strARange As String = "A1:A6"     '入力セル
Const strCRange As String = "D1:D5"     'リストセル

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ARange As Range
    Dim CRange As Range
    Dim s As String
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Cancel = True
    If MsgBox("入力した内容を変更しますか?", vbYesNo + vbQuestion) = vbYes Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect Password:="1234"
        With ARange
            .Locked = False
            .Validation.Delete
            .ClearContents
        End With
        
        s = dList()
        If s <> "" Then
            With Cells(ARange.Row, ARange.Column).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=dList()
                ActiveSheet.Protect
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = True
            End With
        Else
            MsgBox "リストが設定されていません"
        End If
        Application.EnableEvents = True
    End If
End Sub

Private Function dList() As String
    Dim s As String
    Dim r As Range
    For Each r In Range(strCRange)
        If Range(strARange).Find(r.Value, lookat:=xlWhole) Is Nothing Then
            s = s & "," & r.Value
        End If
    Next
    dList = s
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ARange As Range
    Dim CRange As Range
    Set ARange = Range(strARange)
    Set CRange = Range(strCRange)
    If Intersect(Target, ARange) Is Nothing Then Exit Sub
    Dim s As String
    Dim r As Range
    
    If Target.Row < ARange.Row + ARange.Count - 1 Then
        If Target.Value = "-" Then
            Target.Offset(1, 0).Value = "-"
        Else
            s = dList()
            If s = "" Then
                Target.Offset(1, 0).Value = "-"
            Else
                Target.Offset(1, 0).Validation.Delete
                With Target.Offset(1, 0).Validation
                    ActiveSheet.Unprotect Password:="1234"
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=s
                    ActiveSheet.Protect
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .IMEMode = xlIMEModeNoControl
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    End If
    Target.Validation.Delete
End Sub

※コード中エラーで止まった後、右クリックしてもメッセージボックスがでない場合、

一時的にイベントが起こらなくなっている可能性があります。

そのときはイミディエイトウィンドウに以下を入力してエンターを押してください。

Application.EnableEvents =True

id:kn1967 さんのコードを参考にさせて頂きました。ありがとうございました。

http://q.hatena.ne.jp/

id:hawk007

SALINGER 様

いつもお世話になっております。

コードの先頭で入力セルとリストセル範囲を指定

できるようにして頂き、大変移植が容易になりました。

ありがとうございます。

2009/12/25 08:41:50
id:kn1967 No.3

kn1967回答回数2915ベストアンサー獲得回数3012009/12/22 19:49:52

ポイント26pt

(1)本文

Option Explicit
Const aRangeFormula = "A15:A19", cRangeFormula = "C1:C6"

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Intersect(Target, Range(aRangeFormula)) Is Nothing Then Exit Sub
    If MsgBox("入力した内容を全てクリアしますか?", vbYesNo + vbQuestion) = vbYes Then
        Range(aRangeFormula).Value = ""
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range(aRangeFormula)) Is Nothing Then Exit Sub
    
    Dim tValue As Double
    Dim aRange As Range, a As Range, aMinValue As Double
    Dim cRange As Range, c As Range, cMinValue As Double
    Dim pickupList As String
    
    Set aRange = Range(aRangeFormula)
    Set cRange = Range(cRangeFormula)
    tValue = CDbl(Target(1, 1).Value)
    cMinValue = Application.WorksheetFunction.min(cRange)

    Application.EnableEvents = False
    If (Trim(Target(1, 1).Value) <> "") And (tValue = cMinValue) Then
        aRange.Validation.Delete
        For Each a In aRange
            If a.Value = "" Then a.Value = "--"
        Next
    Else
        aMinValue = Application.WorksheetFunction.Max(cRange) + 1
        For Each a In aRange
            If a.Value = "--" Then
                a.Value = ""
            ElseIf (a.Value <> "") And (CDbl(a.Value) < aMinValue) Then
                aMinValue = Val(a.Value)
            End If
        Next
        pickupList = ""
        For Each c In cRange
            If c.Value < aMinValue Then pickupList = pickupList & ",'" & c.Value
        Next
        pickupList = Mid(pickupList, 2)
        With aRange.Validation
            .Delete
            ActiveSheet.Unprotect Password:="aiueo"
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=pickupList
            ActiveSheet.Protect
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    End If
    Application.EnableEvents = True
End Sub

※回答1への返答欄で追加された4項目には対応済みです。

 範囲を変える場合は2行目の値を変えてください。

 ただし、複数列に渡る指定には未対応です。

※独自に途中まで作ってあったものに手を加えたため

 SALINGER さんとは変数名が異なります。

※Option Explicit はコード入力ミスを避けるため書いてありますが、

 無くても結構です。


(2)おまけ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If (Intersect(Target, Range(aRangeFormula)) Is Nothing) Then Exit Sub
    If Target(1, 1).Row = Range(aRangeFormula)(1, 1).Row Then Exit Sub
    If Target(1, 1).Offset(-1, 0).Value = "" Then
        MsgBox ("未記入のセルがあります。必ず上から順番に値を埋めてください。")
    ElseIf Target(1, 1).Offset(1, 0).Value <> "" Then
        MsgBox ("下のセルが入力済みです。" & vbCrLf _
              & "変更する場合は下のセルを一旦削除してください。")
    End If
End Sub

※セル選択時に独自の規制を設けるための布石となるオプションです。

 今の所は不要だと思いますが、一応。


http://q.hatena.ne.jp/URL必須という項目ははずしておいてもらえると嬉しい。

id:hawk007

kn1967様

いつもお世話になっております。

おまけで教授いだきましたセル選択時に独自の規制を

設けるためのマクロを活用させて戴きます。

ありがとうございます。

2009/12/25 08:48:21
  • id:kn1967
    私がご質問を見た時点で既に回答ついておりますので、回答は控えますが、
    これまでの質問により、どちらの方法を採用なさっておられるのかによって、
    今後の展開は変わってくると思いますので、明確になさったほうがよろしいかと思います。
    (私が回答を控える事によって、強制的に一方に進んでいく事になると思いますが・・・)

    大きな違いは、下記になります。
    SALINGERさん ループはfor/基準は最大値を超える値をプログラムに記述
      セル範囲や、値の数、値そのものが変わった場合にプログラム変更が生じる。
    kn1967 ループはforeach/基準は最小値を自動的に採用
      セル範囲や、値の数が変わった場合にプログラム変更が生じる。

    >入力順番は、A1→A2…A5固定
    どういう目的でドロップダウンリストなのか判りませんが、
    順序が降順と決まっているのであれば、いちいちドロップダウンリストにせず、
    直接C1からC6の値を順にクリックさせて、その結果を
    A1から並べていくほうがスマートではありませんか?
    再考の余地あれば、検討してみてください。
  • id:SALINGER
    前回に引き続きまた保護の解除を忘れたみたいです。
    わかるとは思いますが、コード中の2ヶ所の「.add~」でドロップダウンリストを設定してる前後に
    保護の解除と設定のコードを入れてください。
  • id:SALINGER
    セル範囲や値の数を固定せず柔軟に対応することももちろん可能ですが、
    ExcelVBAに過度な凡用性を持たせることはあまり意味の無い事だと考えています。
    その辺の私の考えはプロフィールに書いてありますので機会があれば見てください。
  • id:kn1967
    別段、どちらがどうというものではないと思ってますし、
    だから回答投稿を控えている訳だったりもするのですが、
    誤解を与えてしまったようで申し訳ないです。> SALINGER さん
  • id:hawk007
    kn1967様、SALINGER様、大変お世話になっております。

    どちらの方法を採用しているかの件
    いろいろと数値等を変更したりして動作を追い勉強しながら
    自分が作成中の実験データの集計まとめのexeclシートに
    移植し試しておる次第です。
    数値等(文字列)を変更した場合にプログラムの変更が容易な方を
    採用させて頂きたいと考えております。

    ドロップダウンリストにしたい理由と致しましては、
    実験時のパラメータの条件と組み合わせの設定を容易にするのと
    同時に設定ミスを防ぐ為にドロップダウンリストにしたいと
    考えております。

    ご面倒をお掛けして申し訳ありません。
    ご教授のほど宜しくお願い申し上げます。
  • id:SALINGER
    ① 上のほうにあるA1もA15になります。セル範囲は一箇所で設定できるものに変更して後で回答します。
    ② それは整数型で扱っているためにエラーとなっています。Doubleに変えることで対応します。
    ③ 文字列とすると、数値の大小が関係なくなるので別物となりますが、必要であればそれも回答します。
    ④ 数式があるセルでもデフォでロックなので外していなければ保護でロックがかかるはずです。
    既にロックが外されているならば数式があるかで判別してロックをかけることは可能です。
  • id:hawk007
    SALINGER 様
    お世話になっております。
    いろいろとご面倒をお掛けして申し訳ありませんが
    何卒よろしくお願い申し上げます。

    また
    ③ 文字列とするとの件、是非教えて頂きたく
    よろしくお願い致します。




  • id:hawk007
    SALINGER様、kn1967様大変お世話になっております。
    現在、お二人に教授いただきましたマクロを
    自作中のエクセルシートに勉強しがら移植してみております。
    おかげさまで、イメージしていたものになりそうです。

    今後とも何卒よろしくお願いもうしあげます。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません