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

  • 質問

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

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

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

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

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

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

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

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

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

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

    式       値                             型

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

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

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

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

    2019年11月28日 3:17

回答

  • 別解です。

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


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

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


    • 編集済み minmin312 2019年12月3日 3:14
    • 回答としてマーク croco8823 2019年12月19日 5:12
    2019年12月3日 3:06

すべての返信

  • 単純な例で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

    2019年11月28日 8:57
  • 試して頂いてありがとうございます。

    そうですか…。

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

    Select Case objUvs.DupeUnique

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

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

    Office365 MSO(16.0.11328.20468)32bit

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

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

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

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

    2019年11月29日 2:16
  • 検証報告のみで恐縮です。

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

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

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

    2019年11月29日 4:37
  • またまたありがとうございます。

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

    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

    2019年11月29日 6:29
  • 同じル-プ(For Each aFC In FCs)の中で、

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

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

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

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

    2019年11月30日 6:33
  • お返事遅くなってすみません!

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

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

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

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

    2019年12月2日 2:24
  • BordersプロパティとNumberFormatプロパティに触れなければエラーにならないようです。

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

    2019年12月2日 4:24
  • >書式設定の方のSelect Case~をコメントアウトしたら問題なく動きました。

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

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

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

    2019年12月2日 6:01
  • 別解です。

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


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

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


    • 編集済み minmin312 2019年12月3日 3:14
    • 回答としてマーク croco8823 2019年12月19日 5:12
    2019年12月3日 3:06
  • >「If aFC.DupeUnique = xlDuplicate Then」の前に、「ThisWorkbook.Worksheets(ACsheetName).Activate」を入れるとどうでしょうか?

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

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

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

    2019年12月7日 12:13
  • 大変遅くなってしまい申し訳ありません。

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

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

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

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


    2019年12月19日 5:12