Excelの質問です。おそらくVBAに関連します。(関数でできたら嬉しいですが・・・)

以下のようなデータから(その下のような)2軸のマトリクス表を自動で作成する方法を教えてください。


あああ | 1,500円 | 2007/3/22
いいい | 8,300円 | 2008/2/18
ううう | 2,400円 | 2008/3/4
えええ | 7,900円 | 2009/5/12
おおお | 5,100円 | 2008/4/25


横軸にA(0~2,000円)、B(2,001~6,000円)、C(6,001~9,999円)
縦軸に1(~2007/12/31)、2(2008/1/1~2008/12/31)、3(2009/1/1~)


例えば、あああ は A1 の位置に、
いいい は C2 の位置にプロット(記入?)されるようにしたいです。
(というか、こういうことはできるのでしょうか?)


よろしくお願いします。

回答の条件
  • 1人5回まで
  • 登録:2008/08/11 09:56:20
  • 終了:2008/08/11 17:41:39

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/08/11 12:55:09

ポイント27pt

まだ仕様が把握しきれていませんが、とりあえず不明な点は推測でやってみました。


ただしセルを追記していくのは面倒なので、とりあえずセルを追加せず一つのセルの中で改行で

追加しています。

目的上、これでは役に立たないということでしたら、後ほど改訂しますがたぶん夕方以降になります。

Option Explicit

Sub myProt()
    Const NAME_COL = "C"
    Const PRICE_COL = "H"
    Const DATE_COL = "J"
    
    Const priceList = "2000,6000,9999"
    Const yearList = "2007,2008,2009"
    
    
    Dim i%, r%, c%, p%, y%
    
    Dim dataWS As Worksheet
    Dim tableWS As Worksheet
    
    Set dataWS = ActiveSheet
    Set tableWS = Worksheets.Add(before:=Worksheets(1))
    
    Dim lastRow As Long
    lastRow = dataWS.Range(NAME_COL & Rows.Count).End(xlUp).Row
    
    Dim pArray, yArray
    pArray = Split(priceList, ",")
    yArray = Split(yearList, ",")
    
    For i = 2 To lastRow '★ 1行目はタイトル行目として2行から開始
        r = 2
        For y = LBound(yArray) To UBound(yArray)
            If Year(dataWS.Cells(i, DATE_COL).Value) <= CLng(yArray(y)) Then
                Exit For
            Else
                r = r + 1
            End If
        Next
        
        c = 2
        For p = LBound(pArray) To UBound(pArray)
            If dataWS.Cells(i, PRICE_COL).Value <= CLng(pArray(p)) Then
                Exit For
            Else
                c = c + 1
            End If
        Next
        
        If tableWS.Cells(r, c).Value = "" Then
            tableWS.Cells(r, c).Value = dataWS.Cells(i, NAME_COL).Value
        Else
            tableWS.Cells(r, c).Value = tableWS.Cells(r, c).Value & vbNewLine & dataWS.Cells(i, NAME_COL).Value
        End If
    Next

    Columns("A:A").ColumnWidth = 26
    Columns("B:D").ColumnWidth = 15
    Dim pp As Long
    For p = LBound(pArray) To UBound(pArray)
        tableWS.Cells(1, p + 2).Value = Format(pp, "##,##") & "~" & Format(pArray(p), "##,##")
        pp = pArray(p) + 1
    Next
    
    For y = LBound(yArray) To UBound(yArray)
        tableWS.Cells(y + 2, "A").Value = Format(DateSerial(yArray(y), 1, 1), "yyyy/mm/dd") & "~" _
        & Format(DateSerial(yArray(y), 12, 31), "yyyy/mm/dd")
    Next
End Sub
id:ysfm

ありがとうございます。

少し放り込んでみて研究してみます。

うまくいきましたらコメントにてご報告します。

2008/08/11 13:08:30

その他の回答(2件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/08/11 12:55:09ここでベストアンサー

ポイント27pt

まだ仕様が把握しきれていませんが、とりあえず不明な点は推測でやってみました。


ただしセルを追記していくのは面倒なので、とりあえずセルを追加せず一つのセルの中で改行で

追加しています。

目的上、これでは役に立たないということでしたら、後ほど改訂しますがたぶん夕方以降になります。

Option Explicit

Sub myProt()
    Const NAME_COL = "C"
    Const PRICE_COL = "H"
    Const DATE_COL = "J"
    
    Const priceList = "2000,6000,9999"
    Const yearList = "2007,2008,2009"
    
    
    Dim i%, r%, c%, p%, y%
    
    Dim dataWS As Worksheet
    Dim tableWS As Worksheet
    
    Set dataWS = ActiveSheet
    Set tableWS = Worksheets.Add(before:=Worksheets(1))
    
    Dim lastRow As Long
    lastRow = dataWS.Range(NAME_COL & Rows.Count).End(xlUp).Row
    
    Dim pArray, yArray
    pArray = Split(priceList, ",")
    yArray = Split(yearList, ",")
    
    For i = 2 To lastRow '★ 1行目はタイトル行目として2行から開始
        r = 2
        For y = LBound(yArray) To UBound(yArray)
            If Year(dataWS.Cells(i, DATE_COL).Value) <= CLng(yArray(y)) Then
                Exit For
            Else
                r = r + 1
            End If
        Next
        
        c = 2
        For p = LBound(pArray) To UBound(pArray)
            If dataWS.Cells(i, PRICE_COL).Value <= CLng(pArray(p)) Then
                Exit For
            Else
                c = c + 1
            End If
        Next
        
        If tableWS.Cells(r, c).Value = "" Then
            tableWS.Cells(r, c).Value = dataWS.Cells(i, NAME_COL).Value
        Else
            tableWS.Cells(r, c).Value = tableWS.Cells(r, c).Value & vbNewLine & dataWS.Cells(i, NAME_COL).Value
        End If
    Next

    Columns("A:A").ColumnWidth = 26
    Columns("B:D").ColumnWidth = 15
    Dim pp As Long
    For p = LBound(pArray) To UBound(pArray)
        tableWS.Cells(1, p + 2).Value = Format(pp, "##,##") & "~" & Format(pArray(p), "##,##")
        pp = pArray(p) + 1
    Next
    
    For y = LBound(yArray) To UBound(yArray)
        tableWS.Cells(y + 2, "A").Value = Format(DateSerial(yArray(y), 1, 1), "yyyy/mm/dd") & "~" _
        & Format(DateSerial(yArray(y), 12, 31), "yyyy/mm/dd")
    Next
End Sub
id:ysfm

ありがとうございます。

少し放り込んでみて研究してみます。

うまくいきましたらコメントにてご報告します。

2008/08/11 13:08:30
id:Baku7770 No.2

Baku7770回答回数2831ベストアンサー獲得回数1812008/08/11 14:52:13

ポイント26pt

 関数でできますよ。

 まず、元のデータの前3列程入れます。A、B、C列とします。

 A列には横軸の値が算出できるように、B列には縦軸の値が算出できるように(後述)します。C列には[=A&B]として例えばA1とかC3を算出できるようにします。

 集計表は別シートでA列に2行目から1、2、3…(ちゃんと文字型にして下さい)と並んでいるとし、1行目にはB列からA、B、C…と並んでいるとして

 B2に以下のように記述します。

[=IF(ISERROR(VLOOKUP(B$1&$A2,Sheet1!$C$1:$D$8,2,FALSE)),"",VLOOKUP(B$1&$A2,Sheet1!$C$1:$D$8,2,FALSE))]

 これをコピペすると計算できるようになります。シート名と範囲は調整してください。

 さて横軸と縦軸の算出ですがIF文を使って求めるもよいでしょうし、VLOOKUP関数で算出しても良いでしょう。くれぐれも縦軸を文字型にすることをお忘れなく。

id:ysfm

ありがとうございます。

こちらも試してみます。

2008/08/11 15:26:39
id:Mook No.3

Mook回答回数1312ベストアンサー獲得回数3912008/08/11 15:17:05

ポイント27pt

内容は全く変更していませんが、コメントを追加しました。

Option Explicit

Sub myProt()
'★ データ列の定義
    Const NAME_COL = "C"
    Const PRICE_COL = "H"
    Const DATE_COL = "J"
    
'★ 分析範囲の定義
'--- 価格の分類:小さい順に記載すること
    Const priceList = "2000,6000,9999"
'--- 年の分類:小さい順に記載すること
    Const yearList = "2007,2008,2009"
    
    
    Dim i%, r%, c%, p%, y%
    
    Dim dataWS As Worksheet
    Dim tableWS As Worksheet
    
'★ 結果用として新規シートを先頭に作成
    Set dataWS = ActiveSheet
    Set tableWS = Worksheets.Add(before:=Worksheets(1))
    
'★ 名前列の最終行を取得
    Dim lastRow As Long
    lastRow = dataWS.Range(NAME_COL & Rows.Count).End(xlUp).Row
    
'★ 解析用に配列を作成
    Dim pArray, yArray
    pArray = Split(priceList, ",")
    yArray = Split(yearList, ",")
    
'★★★ 解析処理
'---   i はデータシートの行
'---   c, r は結果シートの列(column)と行(row)
    For i = 2 To lastRow '★ 1行目はタイトル行目として2行から開始
'★ 日付行の計算
        r = 2
        For y = LBound(yArray) To UBound(yArray)
        '---   年とデータ配列を比較して位置を求める
            If Year(dataWS.Cells(i, DATE_COL).Value) <= CLng(yArray(y)) Then
                Exit For
            Else
                r = r + 1
            End If
        Next
        
'★ 価格列の計算
        c = 2
        For p = LBound(pArray) To UBound(pArray)
        '---   価格とデータ配列を比較して位置を求める
            If dataWS.Cells(i, PRICE_COL).Value <= CLng(pArray(p)) Then
                Exit For
            Else
                c = c + 1
            End If
        Next
        
'★ 結果の記入
        If tableWS.Cells(r, c).Value = "" Then
            tableWS.Cells(r, c).Value = dataWS.Cells(i, NAME_COL).Value
        Else
            tableWS.Cells(r, c).Value = tableWS.Cells(r, c).Value & vbNewLine & dataWS.Cells(i, NAME_COL).Value
        End If
    Next

'★★★ 結果シートの整形
    Columns("A:A").ColumnWidth = 26
    Columns("B:D").ColumnWidth = 15
    
'★ 結果シートのタイトル列の表示:A列の表示
    Dim pp As Long
    For p = LBound(pArray) To UBound(pArray)
        tableWS.Cells(1, p + 2).Value = Format(pp, "##,##") & "~" & Format(pArray(p), "##,##")
        pp = pArray(p) + 1
    Next
    
'★ 結果シートのタイトル行の表示:1行目の表示
    For y = LBound(yArray) To UBound(yArray)
        tableWS.Cells(y + 2, "A").Value = Format(DateSerial(yArray(y), 1, 1), "yyyy/mm/dd") & "~" _
        & Format(DateSerial(yArray(y), 12, 31), "yyyy/mm/dd")
    Next
End Sub
id:ysfm

ありがとうございます。

いろいろ調べながらコードを解読していました。

なんとかこれを元に応用できるよう試行錯誤してみます。

2008/08/11 15:27:33
  • id:Mook
    同じセルに該当する項目が複数あった場合はどうするのですか?
  • id:ysfm
    説明不足ごめんなさい。
    同じセルに該当する項目が複数あった場合は、その下のセルに名前(いいい や ううう)が入力されるイメージです。
  • id:Mook
    その下ということは、縦軸は1~3の範囲ではないということですか。

    また、データのあるシートと結果を出力するシートは別ですか。
    そのデータの位置は具体的にどのようになっていますか。
  • id:kn1967
    VBAでも簡単ですが
    あああ | 1,500 | 2007/3/22 | A | 1
    ううう | 2,400 | 2008/3/ 4 | B | 2
    おおお | 5,100 | 2008/4/25 | B | 2
    いいい | 8,300 | 2008/2/18 | C | 2
    えええ | 7,900 | 2009/5/12 | C | 3
    といった形で縦に並ぶのでも良ければVBAを使わずに出来ますけど・・・。
    ちなみに、使う関数はVLOOKUPだけですがよろしければ投稿しましょうか?

  • id:ysfm
    > その下ということは、縦軸は1~3の範囲ではないということですか。
    はい。そうなります。

    > また、データのあるシートと結果を出力するシートは別ですか。
    それはどちらでもかまいません。

    > そのデータの位置は具体的にどのようになっていますか。
    具体的にどのようとはどういう意味でしょう?
    データの入った表だけのシートで、A1からO30あたりまでのデータです。


    > VBAでも簡単ですが
    > あああ | 1,500 | 2007/3/22 | A | 1
    > ううう | 2,400 | 2008/3/ 4 | B | 2
    > おおお | 5,100 | 2008/4/25 | B | 2
    > いいい | 8,300 | 2008/2/18 | C | 2
    > えええ | 7,900 | 2009/5/12 | C | 3
    > といった形で縦に並ぶのでも良ければVBAを使わずに出来ますけど・・・。
    > ちなみに、使う関数はVLOOKUPだけですがよろしければ投稿しましょうか?
    A~C、1~3を関数で入力してソートすることはできるのですが、
    それを縦軸と横軸のあるマトリクス表に再配置したいのです。
    VLOOKUPだけでできそうでしたら、よろしくお願いします。
  • id:Mook
    えっ?なぜデータがO列まであるのですか。
    提示されたデータでは3列しかないのですが、その中で使用するのが
    AからC列だけということでしょうか。

    また、同じ年のデータを下に追記していくとすると、タイトル行がない場合、
    どのようにその日付範囲を判断するのですか。
    その判断は不要ということでしょうか。
  • id:kn1967
    >縦軸と横軸のあるマトリクス表に再配置したいのです。

    関数だけで出来るのは、
    例に挙げましたような表にするところまでです。

    VBAはMook氏の回答を待つほうが早くて丁寧ですから
    私は「見」に移行します。
  • id:ysfm
    > えっ?なぜデータがO列まであるのですか。
    > 提示されたデータでは3列しかないのですが、その中で使用するのが
    > AからC列だけということでしょうか。
    いえ、A~Oまである中で3つのデータ(名前、金額、日付)を使いたいのです。
    元データではそれぞれC列、H列、J列ですが、今後も列の挿入/削除が入る可能性のあるデータです。


    > また、同じ年のデータを下に追記していくとすると、タイトル行がない場合、
    > どのようにその日付範囲を判断するのですか。
    > その判断は不要ということでしょうか。
    すみません。質問の意味が理解できませんでした。
    日付判断が困難な場合、別シートでのマトリクス表出力という形になるのでしょうか?


    1つ、話をややこしくしている原因に気づきました。
    質問文の中のA1やC2はマトリクス上のもので、
    A列、1行とは無関係のものです。ややこしくてごめんなさい。

    データのレベルを○円~○円でa,b,cと、○/○~○/○でア,イ,ウとわけて、
    それぞれが交差するところに、自動で名前(あああ,いいい 等)が配置されるようにしたいのです。
  • id:ysfm
    > >縦軸と横軸のあるマトリクス表に再配置したいのです。
    >
    > 関数だけで出来るのは、
    > 例に挙げましたような表にするところまでです。
    >
    > VBAはMook氏の回答を待つほうが早くて丁寧ですから
    > 私は「見」に移行します。
    ありがとうございます。
    また何か気づかれましたらご教授ください。
  • id:Mook
    ここまでいろいろ聞いておいて回答しなかったら顰蹙かな。
    満足するレベルの回答には至っていないと思いますが、とりあえず暫定の回答です。

    関数だけで実現できそうな気もしますが、私はどうも関数が苦手なのでVBAで回答しました。


  • id:ysfm
    ありがとうございます。
    質問文のデータでイメージしていたマトリクス表ができました。

    ただいくつか問題も・・・
    数字(値段)を大きくしたり、日付の変わる位置を年から月にしたり、行や列が変わったりしたとき、
    コードをいじるとエラーが出たりで、よくわからなくなってしまいました。
    (思っていた以上に私自身のレベルよりも高いもので、Excelのヘルプを読むもちんぷんかんぷん・・・)

    すべて伺ってしまうとさすがに失礼ですし、私自身の勉強にもならないと思っています。

    できれば、
    > '★ 1行目はタイトル行目として2行から開始
    のように、内容を記述頂けると助かります。

    どうかよろしくお願いします。
  • id:Mook
    コメントでもよかったかもしれませんが、スーパープレ記法の方が見やすいと思いましたので、
    再回答しました。

    例示されたサンプルを基準に、年だけで分類する仕様になっていますので月単位で分類するには
    処理の変更が必要です。
        If Year(dataWS.Cells(i, DATE_COL).Value) <= CLng(yArray(y)) Then
    がその判定をしているところですが、Datediff などの関数を使い日付として判断をするように
    変更が必要でしょう。
    タイトル行の表示に関しても同様に月に対応する処理が必要です。
  • id:ysfm
    コメントありがとうございます。
    やはり月単位ですとまた別の処理が必要だったのですね。

    再回答でも問題ございません。見やすくて助かりました。
    コードのコメント部分も新たなご回答ですし(またたくさんコメント欄でもお返事頂いていますし)そのままポイントは差し上げます。
  • id:Mook
    いるか賞ありがとうございました。

    月単位への変更点で不明な点があったらコメントください。
  • id:Mook
    明日からしばらくアクセスできないので、日単位への変更の場合のサンプル例です。

    (1)先頭部分を下記のように変更:最後のデータの後に以降が追加されるので2009は不要。
    '--- 年の分類:小さい順に記載すること
      Const yearList = "2007/12/31,2008/6/30,2008/12/31"

    (2)前のコメントで記載した部分を、下記の条件式に変更
      If dataWS.Cells(i, DATE_COL).Value <= CDate(yArray(y)) Then


    (3)日付のタイトル行処理を下記のように変更(コメントの列と行が反対でした。)
    '★ A列の表示
      tableWS.Cells(2, "A").Value = "~" & Format(CDate(yArray(0)), "yyyy/mm/dd")
      For y = LBound(yArray) + 1 To UBound(yArray)
        tableWS.Cells(y + 2, "A").Value = Format(CDate(yArray(y - 1)) + 1, "yyyy/mm/dd") & "~" _
          & Format(CDate(yArray(y)), "yyyy/mm/dd")
      Next
      tableWS.Cells(y + 2, "A").Value = Format(CDate(yArray(y - 1)) + 1, "yyyy/mm/dd") & "~"

    これで、日付分類が先頭の例では
     ~2007/12/31
     2008/01/01~2008/06/30
     2008/07/01~2008/12/31
     2009/01/01~      : この行は自動で追加
    という分類になります。
  • id:ysfm
    ありがとうございます。
    日付変更のサンプルも参考にしながらいろいろ試しています。

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

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

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

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