UniqueValuesのDupeUniqueプロパティについて

Question

Excelの条件付き書式を書き出す処理をしています。

FormatCondition.Type が xlUniqueValues の場合、「重複」か「一意」どちらの設定になっているかを取得する必要があり、

FormatCondition（実際はUniqueValuesオブジェクト）のDupeUniqueプロパティを参照しようとしているのですが、

下記のエラーが発生して取得できません。

-------------------------

実行時エラー '-2147417848(80010108)':

'DupeUnique'メソッドは失敗しました: 'UniqueValues' オブジェクト

-------------------------

ちなみにウォッチ式でFormatConditionオブジェクトを確認した場合も、下記のように表示されます。

-------------------------

式　　　　　　　値　　　　　　　　　　　　　　　　　　　　　　　　　　　　　型

Dupe Unique　<アプリケーション定義またはオブジェクト定義のエラーです。>　XlDupeUnique

-------------------------

なぜこのプロパティが取得できないのか、回避策がないのか、ご教示いただければありがたいです。

よろしくお願いいたします。

Answer 1

単純な例でXl2010/2013(32bit)で確認しましたが、エラーはでませんでした。

Sub exsample()

    Dim objFCs As FormatConditions: Set objFCs = Range("A1").FormatConditions
    Dim objUvs As UniqueValues: Set objUvs = objFCs.Item(1)
    
    If objUvs.Type = xlUniqueValues Then
        
        Select Case objUvs.DupeUnique
        Case xlUnique:    Debug.Print "一意"
        Case xlDuplicate: Debug.Print "重複"
        End Select
        
    End If
    
    Set objUvs = Nothing
    Set objFCs = Nothing

End Sub

Answer 2

試して頂いてありがとうございます。

そうですか…。

記載いただいた例で試してみても、やはり

Select Case objUvs.DupeUnique

のところでエラーになります。

当方の環境は下記になります（記載しておらずすみません）。

Office365 MSO（16.0.11328.20468）32bit

環境によるものでしょうか。。

Answer 3

あらゆるパターンの条件付き書式をテストするため、下記の順番に設定していたのですが、
UniqueValuesの優先順位を14番目から1番目にしたところ、エラーが出ないことがわかりました。
ただし2番目以降にするとやはりエラーになります。

※指定がないものはすべてFormatCondition
(1) セルの値　次の値の間
(2) セルの値　次の値に等しい
(3) セルの値　次の値により大きい
(4) 演算
(5) テキスト　次の値で始まる
(6) テキスト　次の値を含まない
(7) 日付
(8) 空白
(9) 空白以外
(10) エラー
(11) エラー以外
(12) 平均　平均より上                   型：AboveAverage
(13) 平均　平均より１標準偏差上     型：AboveAverage
(14) 重複/一意                             型：UniqueValues
(15) 上位/下位                             型：Top10
(16) カラースケール                      型：ColorScale
(17) データバー                            型：Databar
(18) アイコンセット                      型：IconSetCondition

優先順位の1番目と2番目にUniqueValuesの条件を入れた場合、2番目の方でエラーになるので
そのあたりに原因がありそうですが、、、

Answer 4

検証報告のみで恐縮です。

Xl2016(Ver1910-64bit)で試しましたが、エラーはでませんでした。

１つ目に「上位/下位」、２つ目に「重複/一意」とし、「Set objUvs = objFCs.Item(2)」と書き換えても、変わらずエラーは発生しませんでした。

その後、条件付き書式を２つほど追加して試しましたが、やはりエラーはでませんでした。

Answer 5

またまたありがとうございます。

ファイルが壊れてしまっているのかと思い、新しいブックで一から作成し直しても
やはり２つ目でエラーになってしまいます。

Sub xxxxxx()

    Dim ACsheetName As String
    Dim SH1 As Worksheet
    Dim FCs As Variant
    Dim aFC As Variant 'As FormatCondition ''--他の型が入る可能性があるため型指定はしない
    Dim i, j
    Dim hArr As Variant
    
    Const header As String = "範囲,タイプ,判定方法,条件1,条件2,書式,塗りつぶし色,罫線色,フォントスタイル,フォント色,表示形式,その他設定1,その他設定2,その他設定3,,型"
    Const none As String = "（設定なし）"
    
    ACsheetName = Application.ActiveSheet.Name
    Set SH1 = Application.Worksheets.Add
    
    On Error Resume Next
    SH1.Name = "※条件付き書式→" & ACsheetName
    On Error GoTo 0
    
    On Error GoTo errHandler
    
    With SH1
    hArr = Split(header, ",")
    .Range("A1:P1") = hArr
    i = 1
    
    Set FCs = Application.Sheets(ACsheetName).Cells.FormatConditions
    
    For Each aFC In FCs
        i = i + 2
        
        .Cells(i, 1) = "'" & aFC.AppliesTo.Address  ''--範囲
        .Cells(i, 2) = "'" & getXlFormatConditionType(aFC.Type)  ''--タイプ
        .Cells(i, 16) = "'" & TypeName(aFC) ''--型
        
        ''■■■■判定方法、条件1、条件2■■■■■■■■
        Select Case aFC.Type
        
        ''--セルの値
        Case xlCellValue
            .Cells(i, 3) = getXlFormatConditionOperator(aFC.Operator)
            .Cells(i, 4) = "'" & aFC.Formula1
            
            If aFC.Operator = xlBetween Or aFC.Operator = xlNotBetween Then
                .Cells(i, 5) = "'" & aFC.Formula2
            End If
        
        ''--演算
        Case xlExpression
            .Cells(i, 4) = "'" & aFC.Formula1
        
        ''--テキスト
        Case xlTextString
            .Cells(i, 3) = getXlContainsOperator(aFC.TextOperator)
            .Cells(i, 4) = "'" & aFC.Text
            
        ''--日付
        Case xlTimePeriod
            .Cells(i, 3) = getXlTimePeriods(aFC.DateOperator)
            
        ''--空白、空白以外、エラー、エラー以外
        Case xlBlanksCondition, xlNoBlanksCondition, xlErrorsCondition, xlNoErrorsCondition
            .Cells(i, 3) = getXlFormatConditionType(aFC.Type)
                
        ''--平均（型はAboveAverage）
        Case xlAboveAverageCondition
            .Cells(i, 3) = getXlAboveBelow(aFC.AboveBelow)
            ''--標準偏差の場合は値も取得
            If aFC.AboveBelow = xlAboveStdDev Or aFC.AboveBelow = xlBelowStdDev Then
                .Cells(i, 4) = aFC.NumStdDev
            End If
            
        ''--重複/一意（型はUniqueValues）
        Case xlUniqueValues

'        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
'        'DupeUniqueを取得しようとするとなぜかエラーになる…
            If aFC.DupeUnique = xlDuplicate Then
                Cells(i, 3) = "重複する値"
            Else
                Cells(i, 3) = "一意の値"
            End If
'        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
        
        ''--上位/下位（型はTop10）
        Case xlTop10
            If aFC.TopBottom = xlTop10Top Then
                .Cells(i, 3) = "上位"
            Else
                .Cells(i, 3) = "下位"
            End If
            .Cells(i, 4) = aFC.Rank
            If aFC.Percent Then
                .Cells(i, 5) = "%"
            Else
                .Cells(i, 5) = "位"
            End If
        
        ''--カラースケール（型はColorScale）
'        Case xlColorScale
        
        ''--データバー（型はDatabar）
'        Case xlDatabar
        
        ''--アイコンセット（型はIconSetCondition）
'        Case xlIconSets
        
        Case Else
            ''判定方法、条件はブランク
            
        End Select
        
        ''■■■■書式設定■■■■■■■■■■■■
        Select Case aFC.Type
        
        ''--データバー（型はDatabar）
        Case xlDatabar
'            .Cells(i, 10) = aFC.BarColor.color
'            .Cells(i, 10).Interior.color = aFC.BarColor.color
            ''TODO：枠線の色
        
        '--カラースケール（型はColorScale）、アイコンセット（型はIconSetCondition）
        Case xlColorScale, xlIconSets
            ''TODO
        
        Case Else
            .Cells(i, 6).Value = "1111"
            
            ''--塗りつぶし
            If aFC.Interior.Color = 0 Then
                .Cells(i, 7).Value = none
            Else
                .Cells(i, 6).Interior.Color = aFC.Interior.Color
                .Cells(i, 7).Value = aFC.Interior.Color
            End If
            
            ''--罫線
'            Debug.Print i & "：" & getXlFormatConditionType(aFC.Type)

            Dim borderIndexes As Variant
            borderIndexes = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
    
            For j = 0 To 3
            
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").LineStyle：" & .Cells(i, 8).Borders(borderIndexes(j)).LineStyle
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").Color：" & .Cells(i, 8).Borders(borderIndexes(j)).Color
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").ColorIndex：" & .Cells(i, 8).Borders(borderIndexes(j)).ColorIndex
'                Debug.Print "aFC.Borders(" & j + 1 & ").LineStyle：" & aFC.Borders(j + 1).LineStyle
'                Debug.Print "aFC.Borders(" & j + 1 & ").Color：" & aFC.Borders(j + 1).Color
'                Debug.Print "aFC.Borders(" & j + 1 & ").ColorIndex：" & aFC.Borders(j + 1).ColorIndex
               
               
                If IsNull(aFC.Borders(j + 1).LineStyle) Then
                    .Cells(i, 6).Borders(borderIndexes(j)).LineStyle = xlLineStyleNone
                    .Cells(i, 8).Value = none
                Else
                    .Cells(i, 6).Borders(borderIndexes(j)).LineStyle = aFC.Borders(j + 1).LineStyle
                    On Error Resume Next
                    .Cells(i, 6).Borders(borderIndexes(j)).Color = aFC.Borders(j + 1).Color
                    .Cells(i, 8).Value = aFC.Borders(j + 1).Color
                    On Error GoTo 0
    
                End If
                
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").LineStyle：" & .Cells(i, 8).Borders(borderIndexes(j)).LineStyle
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").Color：" & .Cells(i, 8).Borders(borderIndexes(j)).Color
'                Debug.Print ".Cells(i, 8).Borders(" & j + 1 & ").ColorIndex：" & .Cells(i, 8).Borders(borderIndexes(j)).ColorIndex
                
            Next
            
            ''--フォントスタイル
            If IsNull(aFC.Font.FontStyle) Then
                .Cells(i, 9).Value = none
            Else
                .Cells(i, 6).Font.FontStyle = aFC.Font.FontStyle
                .Cells(i, 9).Value = aFC.Font.FontStyle
            End If

            ''--フォント色
            On Error Resume Next
            If IsNull(aFC.Font.Color) Then
                .Cells(i, 10).Value = none
            Else
                .Cells(i, 6).Font.Color = aFC.Font.Color
                .Cells(i, 10).Value = aFC.Font.Color
            End If
            On Error GoTo 0


            ''--表示形式
            If IsNull(aFC.NumberFormat) Then
                .Cells(i, 11).Value = none
            Else
                .Cells(i, 6).NumberFormat = aFC.NumberFormat
                .Cells(i, 11).Value = "'" & aFC.NumberFormat
            End If


        End Select
        
    Next
    
    .Columns("A:Z").EntireColumn.AutoFit
    End With


finally:
    Set SH1 = Nothing
    Set aFC = Nothing
    Set FCs = Nothing

    Exit Sub
    
errHandler:
    Debug.Print Now() & "　★エラー発生"
    Debug.Print Err.Description
    On Error GoTo 0
    Resume
    
End Sub

Answer 6

同じル－プ（For Each aFC In FCs）の中で、

「'■■■■判定方法、条件1、条件2■■■■■■■■」

「'■■■■書式設定■■■■■■■■■■■■」

の２つを処理しているのが原因かと思います。

とりあえず、「'■■■■書式設定■■■■■■■■■■■■」以下をコメントアウトしたら動きませんか？

Answer 7

お返事遅くなってすみません！

おっしゃるとおり、書式設定の方のSelect Case～をコメントアウトしたら問題なく動きました。

処理を分けたほうが実装がシンプルにできそうだったのでこうしたのですが、ダメなんですね。。

ダメな理由が理解できていないのですが、ご教示いただけないでしょうか。

よろしくお願いいたします。

Answer 8

BordersプロパティとNumberFormatプロパティに触れなければエラーにならないようです。

原因を絞り込んだだけなので、理由はわかりません。

Answer 9

>書式設定の方のSelect Case～をコメントアウトしたら問題なく動きました。

こちら通常実行だと問題なく動くのですが、

デバッグモードでループを１回ずつ実行させると、やはりDupeUniqueを取得する際にエラーが発生してしまいます。

どこかの処理が原因というより、タイミング的なことなんでしょうか。。

Answer 10

別解です。

「If aFC.DupeUnique = xlDuplicate Then」の前に、「ThisWorkbook.Worksheets(ACsheetName).Activate」を入れるとどうでしょうか？

蛇足ですが、以下のコード、ドットが抜けてますよ。

Cells(i, 3) = "重複する値"
Cells(i, 3) = "一意の値"

Answer 11

>「If aFC.DupeUnique = xlDuplicate Then」の前に、「ThisWorkbook.Worksheets(ACsheetName).Activate」を入れるとどうでしょうか？

なるほど…試してみます！

>蛇足ですが、以下のコード、ドットが抜けてますよ。

はい、私も実行して気付きました。。ありがとうございます！

Answer 12

大変遅くなってしまい申し訳ありません。

エラーになってしまうコードの前に、Activateを入れると問題なく動くことがわかりました。

DupeUnique だけでなく、Border.Colorで発生していたエラーも
Activateを入れると解消するようです。

minmin312さん、本当にありがとうございました！

ただ、何故なのか知りたいので、もしおわかりになる方がいたらコメントいただけると幸いです。