[[20211119211904]] 『ある条件に合う値(あるいは値のあるセル)を数え』(駅前) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『ある条件に合う値(あるいは値のあるセル)を数え、分類し、マトリックスを作成する。同じルールを全シートに適用する』(駅前)

具体的な質問です。
以下の例のようにBの列にURLがたくさん記載されています(A列は無視してください)。URLの直前に4種のリンク分類が記載されており、URLはこれで分類されています。URLは無数の可能性がありますが、条件に指定したいURLの種類が4つあります。リンク4分類ごとにURL4種類ごとの数を自動的に計算し、C1からF4に4x4のマトリックスとして数を挿入したいのです。そして、これを100件ある全シートで同じ処理を行いたいのです。いい方法がありますでしょうか?

リンク分類は4種で文字列の有無で指定したいです。つまり"*skos:exactMatch*"があてはまる場合のリンク分類はC列にカウントし、"*rdfs:seeAlso*"の場合はD列にカウントし、"*owl:sameAs*"の場合はE列、"*schema:sameAs*"の場合はF列にカウントします。また、URLの種類も4種で文字列の有無で判別したいです。たとえば、1行目は"dbpedia.org"という文字列がURLに含まれている場合に計算します。つまり=COUNTIF($B:$B; "*dbpedia.org*")です。2行目の基準は=COUNTIF($B:$B; "*id.worldcat.org*"),3行目の基準は=COUNTIF($B:$B; "*loc.gov*")、4行目の基準は=COUNTIF($B:$B; "*viaf.org*")です。

ちょっと難しいのは、リンク分類もURLの種類も出現の有無はランダムです。つまり、シート2のようにいくつかの分類がない場合やURLが一つもない(空白)シートというのもありえます。その場合もC1からF4の該当部分にURLが存在しないということで、0を挿入したいのです。ちなみに、あまり重要ではないでしょうが、URLは同じ種類のものでも(つまり1つの条件に当てはまるものでも)1つとは限りません。たとえば、http://dbpedia.org/resource/Holland
http://nl.dbpedia.org/resource/Hollandなど別々に出現する場合は別々にカウントします。URLの先頭文字はhttpとhttpsしかないと思います。基本はマクロですが、それ以外の方法がもしあれば、お願いします。

シート1

   A    B  
 1    rdfs:seeAlso Links:
 2    http://dbpedia.org/resource/Tomb_of_Alexander_the_Great
 3    owl:sameAs Links:
 4    http://rdf.freebase.com/ns/m.0jrg
 5    http://www.bbc.co.uk/things/813257db-c544-4a00
 6    http://de.dbpedia.org/resource/Alexander_der_Große
 7    skos:exactMatch:
 8    http://d-nb.info/gnd/118501828
 9    http://libris.kb.se/resource/auth/229496
 10    schema:sameAs Links:
 11    http://id.worldcat.org/99j9afefw2223

この場合、以下のようなマトリックスになります。

            C(skos:exactMatch) D(rdfs:seeAlso) E(owl:sameAs) F(schema:sameAs) 
 1(dbpedia.org)        0                1          1          0
 2(id.worldcat.org)    0                0          0          1
 3(loc.gov)            0                0          0          0
 4(viaf.org)           0               0          0          0

シート2

   A    B  
 1    schema:sameAs Links: 
 2    http://d-nb.info/gnd/1888888
 3    http://id.loc.gov/99j9afefw44444
 4    rdfs:seeAlso Links:
 5    http://dbpedia.org/resource/Holland
 6    http://nl.dbpedia.org/resource/Holland

この場合、以下のようなマトリックスになります。

            C(skos:exactMatch) D(rdfs:seeAlso) E(owl:sameAs) F(schema:sameAs) 
 1(dbpedia.org)        0                2          0          0
 2(id.worldcat.org)    0                0          0          0
 3(loc.gov)            0                0          0          1
 4(viaf.org)           0               0          0          0

シート3

   A    B  
 1     
 2    
 3    
   
この場合、以下のようなマトリックスになります。
            C(skos:exactMatch) D(rdfs:seeAlso) E(owl:sameAs) F(schema:sameAs) 
 1(dbpedia.org)        0                0          0          0
 2(id.worldcat.org)    0                0          0          0
 3(loc.gov)            0                0          0          0
 4(viaf.org)           0               0          0          0

1シートのみのmainマクロができれば、同じルールを他のシートに適用したいのですが、複数シート名を指定して(具体的には、必ず三番目から最後までのシート)適用できるマクロがあるとありがたいです。かなり細かいかもしれませんが、できそうな方がいれば、よろしくお願いします。

参考までに、類似した質問があります(https://www.excel.studio-kazu.jp/kw/20190716213412.html

< 使用 Excel:Excel2016、使用 OS:Windows10 >


ちなみにB列の長さは可変ですが、最長で200くらいです。
(駅前) 2021/11/19(金) 22:43

 Option Explicit

 Sub test()
    Dim dic As Object
    Dim ws As Worksheet
    Dim v
    Dim k As Long, s As String
    Dim lnk, url
    Dim r As Long, c As Long
    Dim w(1 To 4, 1 To 4) As Long

    Set dic = CreateObject("scripting.dictionary")

    Set ws = ActiveSheet

    v = ws.Cells(1).CurrentRegion.Columns(2).Value
    For k = 1 To UBound(v)
        s = v(k, 1)
        If Not s Like "http*" Then
            lnk = Left(s, Len(s) - 1)
            lnk = Trim(Replace(lnk, "Links", ""))
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else
            dic(lnk).Add s
        End If
    Next

    c = 0
    For Each lnk In Array("skos:exactMatch", "rdfs:seeAlso", "owl:sameAs", "schema:sameAs")
        c = c + 1
        r = 0
        If dic.exists(lnk) Then
            For Each url In Array("dbpedia.org", "id.worldcat.org", "loc.gov", "af.org")
                r = r + 1
                w(r, c) = UBound(Filter(dic(lnk).toarray, url)) + 1
            Next
        End If
    Next

    ws.Range("D2").Resize(4, 4).Value = w

 End Sub

(マナ) 2021/11/20(土) 13:30


マナさんありがとうございます!ただ、lnk = Left(s, Len(s) - 1)部分がエラーになるようです。VBAは詳しくないのですみませんが、カスタマイズしたいので、できれば
For k = 1 To UBound(v)
        s = v(k, 1)
        If Not s Like "http*" Then
            lnk = Left(s, Len(s) - 1)
            lnk = Trim(Replace(lnk, "Links", ""))
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else
            dic(lnk).Add s
        End If
    Next
の部分を少し説明してもらえるとありがたいのですが・・・。
完全には理解していないのですが、"http"や"Link"などの文字列は気にせず,指定した文字列(*skos:exactMatch*)をREGEX検索指定するだけでは難しそうですか?
(駅前) 2021/11/23(火) 01:37

>の部分を少し説明してもらえるとありがたい

 B列データを1つずつ順番にみていき、
 dictionaryに、リンク分類とURLを紐付けて登録しています。

 データが、リンク分類なのかURLなのかを
 httpで始まらなければ、リンク分類、と判定しています。

 コロン(:)で終われば、リンク分類
 とか
 A列が〇〇であれば、リンク分類
 といった方法でもよいかもしれません。

>"http"や"Link"などの文字列は気にせず,
>指定した文字列(*skos:exactMatch*)を
>REGEX検索指定するだけでは難しそうですか?

 わたしには正規表現はわかりません。

>lnk = Left(s, Len(s) - 1)部分がエラーになるようです。

 すべてのデータでエラーがでますか。
 まずは、提示のサンプルデータで動作確認してください。
 問題なければ、実際のデータをあててみて
 どういった場合に、エラーになるか教えて下さい。
 (想像はできますが)

(マナ) 2021/11/23(火) 14:34


マナさん。返信ありがとうございました。

エラーは普通にSubをRunをしたときに出ました。
「VBA エラー 5 プロシージャの呼び出し、または引数が不正です」。
すべて確認したわけではないですが
lnk = Left(s, Len(s))
にしたところ、なぜかきちんと実際のデータでうまくいったようです。結果オーライではかなり不安ですが・・・。なぜだかわかりますか?

ただ、根本的に以下の部分

        If Not s Like "http*" Then
            lnk = Left(s, Len(s) - 1)
            lnk = Trim(Replace(lnk, "Links", ""))
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else
があまりよくわかりません。リンク分類のセルに出現した文字列を置き換えているようですが、そうする理由がいまいちわかりかねます。
単純に「httpで始まらなければ、リンク分類、と判定」するのではなく、4つのリンク分類の文字列は指定されたものしかないので、rdfs:seeAlsoという文字ががB欄に見つかればそのように処理し、という風にしたいのですが(実をいうとLinks:という部分の文字列は例外があるので使わないようにしました)

VBAの文法がかなり怪しいですが、つまり以下のような感じにはできないでしょうか?(出現した文字列をわざわざ変換せずに、わかっているリンク分類の文字をそのままlnkとして指定します)。そうすればあとのコードを変える必要もなさそうな気がしますが、いかがでしょうか?

        If s Like "*rdfs:seeAlso*" Then
            lnk = "rdfs:seeAlso"
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else

        If Not s Like "http*" Then
            lnk = Left(s, Len(s) - 1)
            lnk = Trim(Replace(lnk, "Links", ""))
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else

(駅前) 2021/11/25(木) 03:51


すみません、2021/11/25(木) 03:51のコメントの最後の以下の部分はコピーペーストを間違えて挿入されてしましました、忘れてください。

        If Not s Like "http*" Then
            lnk = Left(s, Len(s) - 1)
            lnk = Trim(Replace(lnk, "Links", ""))
            Set dic(lnk) = CreateObject("system.collections.arraylist")
        Else
(駅前) 2021/11/25(木) 06:41

>つまり以下のような感じにはできないでしょうか?

可能ですよ。
4種類のリンク分類のどれに該当するかを確認し
どれにも該当しなければ、URLと判断するということですね。
わかりやすいと感じるなら、そのほうがよいです。

 If 〜 then     リンク分類1なら

 elseif 〜 then   リンク分類2なら

 elseif 〜 then   リンク分類3なら

 elseif 〜 then   リンク分類4なら

 else        URLなら

 end if

(マナ) 2021/11/25(木) 21:25


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.