[[20150221150439]] 『イベントプロシージャ?選択したセルを含む行を横』(Ja2136) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『イベントプロシージャ?選択したセルを含む行を横列に貼りつけたいのですが・・・。』(Ja2136)

こんにちは。
CSVファイルで落としたデータを加工してチェックするために使っています。
元データには、研究課題名・課題番号・研究代表者名・所属機関・研究分担者名・所属機関・研究連携者名・所属機関等がずらっと並んでいて、そこから関数で、課題名・番号・代表者名・分担者・連携者名等を取りだしています。
問題は研究分担者・連携者で、同じ大学の分担者と、学外の分担者、そして学内の研究連携者と学外の研究連携者と言う人達がいます。
大学名と分担者コードを元に関数で縦列に取り出したのですが、
それを横に並べたいのです。
私的には、ワークシートのイベントプロシージャで、選択範囲をダブルクリックしたら
横列に並び代わるというのが出来たらありがたいと思っていますが、可能でしょうか?
出来たらコードをご教示下さればありがたいです。
ずっと考えているのですが、縦列のセルが可変であるため、セルの位置取得が難しくて
諦めました。
大変厚かましいお願いですが、よろしくお願い致します。

以下、規格を提示

課題名 番号 代表者名 学内研究分担者 学外分担者 学内研究連携者 学外連携者
学術領域 1111 田中   山田      山本    佐藤      竹本
                池本      谷川    安田      木村
基盤A   2222 澤田  岸本      加藤    有村       中村
            伊藤      津川    前田       光本
            吉田

と縦列に並んでいる名前を

学内分担1 内分担2 学外分担1 外分担2 学内連携1 内連携2 学外連携1 外連携2
山田   池本   山本   谷川   佐藤   安田   竹本   木村

と言う風に横列に並べ替えたいのです。

毎年度違う名前、違う人数のデータですので、可変になるため、セルを指定してのコードは作れません。
それで縦列に山田・池本を選択して、ダブルクリックしたら横列に並び代わるという
イベントプロシージャを思いついたのですが、コードを自分で書けないという情けない状態で困っております。
同かお助け下さいませ。
もし他に何か良い案がございましたら、それもご教示下さればとても嬉しいです。
宜しくお願い致します。               

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 さくっと並び変わった方が簡単に思うので
 その様なコードを書いてみました。

 元データの表は、Sheet1のA1セルから始まっている事を想定しています。
 また、現在何も文字が無い場所には「""」等が返されていると思っています。

 実行すると、Sheet2に結果を表示し Sheet2をアクティブにします。

 '------
Sub Ja2136()
    Dim i As Long, ii As Long, iii As Long
    Dim MyR  As Long, MyC As Long, MxC As Long
    Dim MyCnt As Long
    Dim MyNo As Variant
    Dim tbl As Variant, x As Variant
    Dim dic As Object

    Set dic = CreateObject("Scripting.Dictionary")

    tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Value

    For i = 2 To UBound(tbl, 1)
        If tbl(i, 2) <> "" Then
            MyNo = tbl(i, 2)
        End If
        dic(MyNo) = dic(MyNo) + 1
        If MxC < dic(MyNo) Then
            MxC = dic(MyNo)
        End If
    Next

    ReDim x(1 To dic.Count * 2, 1 To MxC * 4 + 3)

    For i = 2 To UBound(tbl, 1)
        If tbl(i, 2) <> "" Then
            MyR = MyR + 2
            For ii = 1 To 3
                x(MyR - 1, ii) = tbl(1, ii)
                x(MyR, ii) = tbl(i, ii)
            Next

            For ii = 4 To 7
                For iii = 1 To dic(tbl(i, 2))
                    If tbl(i + iii - 1, ii) <> "" Then
                        MyCnt = MyCnt + 1
                        MyC = MyC + 1
                        x(MyR - 1, MyC + 3) = tbl(1, ii) & MyCnt
                        x(MyR, MyC + 3) = tbl(i + iii - 1, ii)
                    End If
                Next
                MyCnt = 0
            Next
            If MxC < MyC + 3 Then
                MxC = MyC + 3
            End If
            MyC = 0
        End If
    Next

    With Sheets("Sheet2")
        .Cells.ClearContents
        .Range("A1").Resize(UBound(x, 1), MxC).Value = x
        .Activate
    End With
End Sub
 '------
  
(HANA) 2015/02/21(土) 17:32

HANA様

こんばんは。
ご無沙汰致しております。
5年ほど前に一度お世話になりました。
その節はありがとうございました。

さて、早速ご提示頂いたコードを実行してみましたが、 x(MyR - 1, ii) = tbl(1, ii)のところで 「実行時エラー”9”、インデックスが有効範囲にありません」と出ます。
すごい変数だらけで、全然理解できないので何が悪いのかもわかりません。
シートの構成に問題ありますでしょうか?

今作ろうとしているのはシートが4枚構成で、シート1が使い方説明、シート2がCSV貼り付けシート、シート3が関数を入れたチェックシート原本でシート4がそのコピーです。
シート3で縦列に学内・外分担者や、学内・外連携者をCSV貼り付けシートから引っ張って来て、ここでシート4に並べ替えるというつもりなんですが・・・。

度々申し訳ございませんが、どう直せばよいかご教示下さい。

(Ja2136) 2015/02/21(土) 22:18


 エラーですか。
 なんですかね。。。

 シートは何枚あっても関係ないです。
 Sheet1,Sheet2と言うシート名のシートがあって
 Sheet1のA1セルから、元になる表が始まっていれば大丈夫です。

 シートの構成より、データの状態の方が問題だと思います。

 とりあえず、このコードはご呈示のデータを使って作りましたので
 同じ表(数式ではなく、値で 空白部分には本当に空白になっているもの)を作って
 試してみてもらえますか?

 それから、エラーになった時の、MyR,ii の値をそれぞれ教えて下さい。
 VBEでローカルウィンドウを表示してもらうと確認が簡単かもしれません。
  
(HANA) 2015/02/21(土) 23:35

HANA様

おはようございます。
不思議なんですが、テストとして提示しましたデータで試しましたら、ちゃんとsheet2に横並びに転記されました。
ただ実際のデータでやりますと、どうしてもエラー出て止まってしまい、デバックがx(MyR - 1, ii) = tbl(1, ii)に出ますので、ローカルウィンドウで確認しましたところ、MyRの値が26、iiの値が1で型がLongでした。
ローカルウィンドウって初めて使いましたが(汗)
う〜ん、やっぱり数式が入っているとダメなんでしょうか?
と思って、値だけコピーしたシートを用意してテストしてみましたが、やっぱりデバック出ます。
同じところ・・・。
何故なんでしょう?
休日に大変申し訳ございませんが、ご教示下さいませ。
(Ja2136) 2015/02/22(日) 10:54


 使っている数式と、どの範囲に入れてあるか。試しているデータでは何行目が最終行か。

 また、もう一度VBEのローカルウィンドウで
  [+]tbl     Variant/Variant( ●●●● )
   [+]x       Variant/Variant( ●●●● )
 の括弧の中に何が入っているか教えて下さい。
  
(HANA) 2015/02/22(日) 11:28

HANA様

使っている数式はたくさんあるのですが、
大したものではなく、=IF(E33<>1,"",CSV!F33&CSV!G33)こんな感じで、CSV貼り付けシートが空白でなかったらそこから拾う。
又学外分担者で、学内か学外か、研究連携者で学内か学外かどうかの区別は
=IF(E34=1,"",IF(AND(E34=2,CSV!K34="○○大学"),CSV!F34&CSV!G34,""))で、担当者コードが分担者だったら2ですので2でなおかつ所属機関が○○大学か、そうでないかで学外か学内かを区別、研究連携者は4でなおかつ所属機関が○○大学かどうかで同じように区別しています。

次にローカルウィンドウ

tbl Variant/Variant(1 to 300, 1 to 23)
x Variant/Variant(1 to 24, 1 to 227)

となっています。
これはいったいどういう意味なんでしょう?

(Ja2136) 2015/02/22(日) 11:53


 そちらで使っているのと同じ様なデータをこちらで作れる情報をもらえませんか?
 面倒とは思いますが、最初にご呈示いただいたものよりも
 より実際のデータに近いもの
  Sheet1に入っているデータ、Sheet1に入れる式
  CSVに入っているデータ
 を作って、おしえてもらえたらと思います。

 >これはいったいどういう意味なんでしょう? 
 tblの方は、Sheet1のA1セルから連なる表が 300行23列(A1:W300)ある って事で
 xの方は、番号が 12種類あって
      番号毎で見た時の最大行数が56行ある って事です。

 サンプルデータでは、Sheet1の表は、A1:G6(6行7列)なので tbl Variant/Variant(1 to 6, 1 to 7) 
 番号が2種類で、「2222」の番号が3行あるので、   x   Variant/Variant(1 to 4, 1 to 15) になります。
 xの方は括弧の中の数字が大きくなっていますが
    ReDim x(1 To dic.Count * 2, 1 To MxC * 4 + 3)
 の所で、演算しているからです。

 行方向は、一つのコードに対して、結果のデータは2行必要
 (見出しが一行・データが一行)なので、 *2 してあります。

 列方向は、たとえば 番号毎で見た時の最大行数が3だった場合
 横に並べると3列必要です。
 それが、学内分担者 学外分担者 学内連携者 学外連携者の4列あるので
 4倍して、さらに最初の3列分のスペースを確保しています。

 サンプルデータの「2222」を見てもらうと
 これは最初の 学内分担者 だけ3行埋まっていますが
 もしもすべてのデータが埋まっていたら
 最初の3列+3×4列 = 15列 結果を書くことになりますよね。

 VBEでコードを貼り付けた白い所の左側に、灰色の部分があると思います。
     For i = 2 To UBound(tbl, 1)
 の行の灰色の部分をマウスでクリックしてもらうと 
 茶色い●がついて、行自体も茶色でハイライトされます。
 ご呈示のデータ(うまく行くデータ)を入れて コードを実行してもらうと
 この行で一旦実行が止まりますので、 tbl と x の内容を確認できる様になると思います。

 今、番号が 12種類ある事を想定して、24行分しか用意していないのに
 >MyRの値が26
 13種類目を処理しようとしているので、エラーになって居ます。

 やはりデータの方に問題があると思いますので
 「値にする」だけでなく、もっと最初にご説明のデータに近づけて
 何を減らした時にエラーが起きなくなるのか 確認してもらえたらと思います。

 値か・数式か 以外にも、色々違うところがありますよね?
  
(HANA) 2015/02/22(日) 13:27

HANA様

そうです。
うっかりしておりました。
まさか全部シートごといっぺんに変換できるなんて考えていなかったので、テスト用のシートは随分端折っておりました(汗)
申し訳ございませんでした。
実際はもっとCSVのデータ量も凄く多く、シート1に転記する行数列数とも多いです。

以下実際のもの
CSVファイルはA列からU列まであり、
事業名、課題名、シーケンス番号、代表者分担者別番号、研究者番号、氏名(漢字姓)、氏名(漢字名)氏名(フリガナ姓)、氏名(フリガナ名)、研究者所属機関番号、研究者所属機関、部局名・・・と項目がありますが、必要なのは事業名、課題名、代表者分担者別番号、氏名、所属機関のみなのです。
行数は毎年違いまして、今年は267行です。
研究によって代表者1人だけのこともあれば、分担者・連携者全て含めて10人ぐらいになることもあります。

新学術領域研究 バクテリアにおける〜 1 田中 正  4423 ○○大学 ○○学部 と言う風にデータが並んでいます。
同じ研究に分担者とか連携者が多ければそれだけ行数が増えます。

それで、次のシートに
事業名、課題名、代表者分担者別番号、代表者、学内研究分担者1、学内分担者2、学内分担者3、学外分担者1、学外分担者2、学外分担者3、学内研究連携者1、学内連携者2、学内連携者3、学外連携者1、学外連携者2、学外連携者3と言う表にしたいのです。
分担者別の番号が1だと研究代表者、2だと研究分担者、4だと研究連携者となります。
それでその種別番号と所属機関とでIF文で学内分担者、学外分担者、学内連携者、学外連携者と取り出すことができたのですが、縦にしかとりだせないので、それを横にしたくて困っています。
又とりあえず、それぞれ3ずつ番号取っているのですが、実は今年は連携者で6人ぐらいの研究があり、実際はもう少し番号を取っておいて、後で必要なかったら必要のない行数列数を非表示或いは削除したいと考えています。
もしすべてをVBAでできるのでしたら、その方がいいのかもしれませんし・・・。

うまく伝わりましたでしょうか?

今少し溜まっている家事をして、夕食の支度をしたら、もう一度上に書いて頂いている物を読み返して自分のデータでやってみます。
いつもうまくまとめる事が出来なくて申し訳ございません。

(Ja2136) 2015/02/22(日) 16:34


 >もしすべてをVBAでできるのでしたら、その方がいいのかもしれませんし・・・。 
 そうですね。CSVから直接変換した方が良い様に思います。

 そこで、元データについてもう少し教えてもらいたいのですが
  A列   事業名
  B列   課題名
  D列   代表者分担者別番号(1,2,4)
  F列&G列 氏名
  K列   研究者所属機関(○○大学,その他)
 で良いですか?

 A,B列などはすべてデータが埋まっていますか?
 データは、事業名・課題名・代表者分担者別番号 の順に並んでいますか?

 >上に書いて頂いている物を読み返して自分のデータでやってみます。
 いや、最初のコードはもう使わないので
 先にデータについて教えてもらえたらと思います。
  
(HANA) 2015/02/22(日) 17:44

HANA様

全部VBAでできるのでしたらその方がとてもありがたいです。
データは267行分全部詰まっています。
HANA様の書かれてるので大体あってますが、
課題名と代表者分担者別番号の間にシーケンス番号(C列)があります。
D列に代表者分担者別番号が来て、FとG列で氏名。
後はHとIでフリガナ氏名。
J列が所属機関番号
K列が所属機関(○○大学)
となっています。

もしそれでVBAで一括変換できるのでしたらとても素晴らしいです。
宜しくお願い致します。

(Ja2136) 2015/02/22(日) 18:20


 >課題名と代表者分担者別番号の間にシーケンス番号(C列)があります。
 でも、C列は要らないんですよね?

 ちなみに、シーケンス番号って何の番号ですか?
 通し番号?

 当初の表には2番目に「番号」と言うのがありますがこれは要らないですか?

 とりあえず、こんな感じにしてみました。
 '------
Sub Ja2136_CSV2()
    Dim i As Long
    Dim MyR  As Long, xc As Long
    Dim tbl As Variant, x As Variant
    Dim Cnt1 As Long, Cnt2 As Long, Cnt4 As Long
    Dim MyCnt2 As Long, MyCnt3 As Long, MyCnt4 As Long, MyCnt5 As Long
    Dim MxCnt2 As Long, MxCnt3 As Long, MxCnt4 As Long, MxCnt5 As Long
    Dim x1 As Variant, x2 As Variant, x3 As Variant, x4 As Variant, x5 As Variant

    With Sheets("CSV")
        tbl = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row, 21).Value
        Cnt1 = Application.CountIf(.Range("D:D"), 1)
        Cnt2 = Application.CountIf(.Range("D:D"), 2)
        Cnt4 = Application.CountIf(.Range("D:D"), 4)
    End With

    If Cnt1 > 0 Then

        ReDim x1(1 To Cnt1, 1 To 3)     '事業名・課題名・代表者氏名用
        ReDim x2(1 To Cnt1, 1 To Cnt2)  '学内分担者用
        ReDim x3(1 To Cnt1, 1 To Cnt2)  '学外分担者用
        ReDim x4(1 To Cnt1, 1 To Cnt4)  '学内連携者用
        ReDim x5(1 To Cnt1, 1 To Cnt4)  '学外連携者用

        For i = 2 To UBound(tbl, 1)
            Select Case tbl(i, 4)
                Case 1  '代表者
                        MyR = MyR + 1
                        MyCnt2 = 0: MyCnt3 = 0: MyCnt4 = 0: MyCnt5 = 0
                        x1(MyR, 1) = tbl(i, 1)                      '事業名
                        x1(MyR, 2) = tbl(i, 2)                      '課題名
                        x1(MyR, 3) = tbl(i, 6) & " " & tbl(i, 7)   '代表者氏名
                Case 2  '分担者
                    If tbl(i, 11) = "○○大学" Then     '学内分担者
                        MyCnt2 = MyCnt2 + 1
                        If MxCnt2 < MyCnt2 Then MxCnt2 = MyCnt2
                        x2(MyR, MyCnt2) = tbl(i, 6) & " " & tbl(i, 7)
                    Else                                '学外分担者
                        MyCnt3 = MyCnt3 + 1
                        If MxCnt3 < MyCnt3 Then MxCnt3 = MyCnt3
                        x3(MyR, MyCnt3) = tbl(i, 6) & " " & tbl(i, 7)
                    End If
                Case 4  '連携者
                    If tbl(i, 11) = "○○大学" Then     '学内連携者
                        MyCnt4 = MyCnt4 + 1
                        If MxCnt4 < MyCnt4 Then MxCnt4 = MyCnt4
                        x4(MyR, MyCnt4) = tbl(i, 6) & " " & tbl(i, 7)
                    Else                                '学外連携者
                        MyCnt5 = MyCnt5 + 1
                        If MxCnt5 < MyCnt5 Then MxCnt5 = MyCnt5
                        x5(MyR, MyCnt5) = tbl(i, 6) & " " & tbl(i, 7)
                    End If
            End Select
        Next

        'タイトル行の作成
        ReDim x(1 To 1, 1 To 3 + MxCnt2 + MxCnt3 + MxCnt4 + MxCnt5)
            x(1, 1) = tbl(1, 1)
            x(1, 2) = tbl(1, 2)
            x(1, 3) = "代表者氏名"
            xc = 3
        For i = 1 To MxCnt2
            xc = xc + 1
            x(1, xc) = "学内分担者" & i
        Next
        For i = 1 To MxCnt3
            xc = xc + 1
            x(1, xc) = "学外分担者" & i
        Next
        For i = 1 To MxCnt4
            xc = xc + 1
            x(1, xc) = "学内連携者" & i
        Next
        For i = 1 To MxCnt5
            xc = xc + 1
            x(1, xc) = "学外連携者" & i
        Next

        '書き出し
        With Sheets("Sheet2")
            .Cells.ClearContents
            .Range("A1").Resize(1, UBound(x, 2)).Value = x
            xc = 0
            .Range("A2").Offset(, xc).Resize(Cnt1, UBound(x1, 2)).Value = x1
            xc = xc + UBound(x1, 2)
            If MxCnt2 > 0 Then .Range("A2").Offset(, xc).Resize(Cnt1, MxCnt2).Value = x2
            xc = xc + MxCnt2
            If MxCnt3 > 0 Then .Range("A2").Offset(, xc).Resize(Cnt1, MxCnt3).Value = x3
            xc = xc + MxCnt3
            If MxCnt4 > 0 Then .Range("A2").Offset(, xc).Resize(Cnt1, MxCnt4).Value = x4
            xc = xc + MxCnt4
            If MxCnt5 > 0 Then .Range("A2").Offset(, xc).Resize(Cnt1, MxCnt5).Value = x5
            .Activate
        End With
    End If
End Sub
 '------
   
(HANA) 2015/02/22(日) 20:35

HANA様

スゴイコードですね!!(;^ω^A
ビックリ〜!!
ありがとうございます♪

>でも、C列は要らないんですよね?
そうです、要りません。
シーケンス番号って一体何の番号なのか私も実は謎です(苦笑)

で、コピペさせて頂いて実行しましたところ、1004のエラーです。
アプリケーション定義又はオブジェクト定義のエラーですと表示されました。
デバックは.Range("A2").Offset(, xc).Resize(Cnt1, MxCnt2).Value = x2の行です。
???
ちなみにローカルウィンドウで見ると
Mxcnt2の値は0

 x2の値は1 to 132 , 1 to 41でした。
sheet2(ちなみに私のはsheet3ですが)には事業名・研究課題名・代表者名の3列しか来ておらず、行数は133行、です。

コードそのものも全然わからない為何が悪いのかもわかりません。
offsetって(,xc)っていう使い方もできるんですね?
コレだと、行は変わらないって事でしょうか?同じ行のxc列を指定してるのかしら?
う〜ん、あんまりにもハイレベル過ぎて理解できそうにもないですが(涙)
度々恐縮でございますが、再度ご教示下さいませ。

しかしHANA様、理系のご出身でいらっしゃいますか?
こういうプログラマーの方って、やっぱり数学とかすごくおできになるんでしょうね?
私みたいな典型的な文系人間は、VBAも少し習ったのですが、中々理解できないというか、ちょっとずつしか進歩できなくて悲しくなります。
こちらでお助け頂いていつもいつも仕事のピンチを乗り切れており、皆様方にはとても感謝致しております。

(Ja2136) 2015/02/22(日) 22:48


 >Mxcnt2の値は0
 もしかして、学内分担者が居ないデータを使ってますか?

 いずれにしても、コードは問題ありなので↑を直接書き直します。
 コードの名前を Ja2136_CSV1 → Ja2136_CSV2 に変更します。

 貼りつけ直してやってみて下さい。

 >理系のご出身でいらっしゃいますか?
 どちらかと言われると、理系でしたが選択科目は文系寄りでした。
 数学よりも、ロジックパズルとかが好きなのでソッチノ系統かなと思います。
 ピタゴラスイッチみたいな、計画して作って思い通り動いたら達成感がありますよね。
  (実際に作った事はないので、想像ですが。。。)
 マクロも、計画して思い通りに動くものが出来るのが楽しいです。

 仕事が楽になると良いですよね。
 VBAが出来ると、いろいろな事の助けになると思います。
 「VBAを勉強しよう!!」じゃなくて、簡単なものでも作ってみて「仕事が楽になった〜!!」と思えたら
 「もっと楽したい」と思うようになって、VBAも自然に身に付くんじゃないかと思います。

 なんだか締めっぽくなりましたが
 コードの完成まで、もうしばらくお付き合いください。

 学内分担者が居るデータで実行しているのに
 Mxcnt2の値が 0 の場合は、その原因を探らないといけません。
  
(HANA) 2015/02/23(月) 00:04

HANA様

遅くまで申し訳ございません。
学内分担者も学外分担者も学内研究連携者も学外研究連携者もいるデータです。
1と2と4の番号が散らばっているデータです。
しかし転記されたsheet3を見ると事業名・研究課題名・代表者名にはデータがくっついてきていますが、見出しだけ、学外分担者1 学外分担者2 学外分担者3 学外連携者1 学外連携者2 学外連携者3 学外連携者4 学外連携者5 学外連携者6 学外連携者7 学外連携者8 学外連携者9 学外連携者10 学外連携者11 学外連携者12 学外連携者13と入っていて下のデータは来ていません。
学内分担者が見出しにも入っていませんね。
不思議です。

ああ〜、HANA様申し訳ございませんでした。
○○大学をそのまんま使っておりました。
実際の大学名を入れますとちゃんと作動致しました。
うう〜ん、お恥ずかしい(><)

きちんと並んで来ています。
魔法みたい〜。
ありがとうございました。
信じられない気分です。
コメントをつけて下さっているので、それを手掛かりにこのコードを一生懸命解読し、今後に役立てたいです。
変数の使い方が良くわからないもんで・・・(汗)
それとUBoundというのは初めて見ました。
色々奥が深いなあ、Excelって・・・。
ちまちまと関数入れてるよりもVBAだとほんとに一発変換ですね。
何だか楽しくなりました。
本当にどうもありがとうございました。
又今後とも宜しくお願い致します。

(Ja2136) 2015/02/23(月) 00:31


 >○○大学をそのまんま使っておりました。 
 そうでした、「変更して下さい」って書いてなかったですね。

 変数は人それぞれの使い方をするので、自分が作ったものでないと
 難しいと思います。

 UBound と言うのはヘルプで見てもらうと
  配列の指定された次元で使用できる添字の最大値を、長整数型 (Long) の値で返します。
 と書いてあります。

 たとえば、ReDim x1(1 To 10, 1 To 3) があったとして
                  ↑      ↑ 
         UBound(x, 1) = 10      |
                  UBound(x, 2) = 3
 です。

 >offsetって(,xc)っていう使い方もできるんですね? 
 >コレだと、行は変わらないって事でしょうか?同じ行のxc列を指定してるのかしら?
 そうです。
 事業名・課題名・代表者氏名の部分の表 を x1 の中に作っていて
 学内分担者の部分の表を x2の中に、学外分担者の部分の表を x3の中に作っています。

 MxCnt2 とか MxCnt3 には、一つの行に入力した名前の最大値が入っています。
 最初の例だと、学内分担者は「2222」の3が最大なので MxCnt2は「3」
        学外分担者は「1111」も「22222」も2なので MxCnt3は「2」

 x1の中身は、A列から書き出せば良いです。
            xc = 0
 xcは 0 なので
            .Range("A2").Offset(, xc).Resize(Cnt1, UBound(x1, 2)).Value = x1
 Offsetつけてますが、付けてなくても同じです。

 x2の中身は、x1を書き出した次の列から書き出します。
            xc = xc + UBound(x1, 2)
 UBound(x1, 2)が、x1の列数(今回は、添字の最大値と列数が一致しているので)=3なので
 xcは「3」です。
            .Range("A2").Offset(, xc).Resize(Cnt1, MxCnt2).Value = x2
 x2は、A列から0,1,2,3・・・と数えて 3番目=D列から書き出します。

 x3の中身は、さらにその後ろの列から書き出します。
            xc = xc + MxCnt2
                    ~~~~~~~~さらにその後ろ
 xcは「6」になるので、G列からの書き出します。

 F8キーを押すと、コードを一行ずつ実行できますので
 ローカルウィンドウで変数の内容を確認しながらやってみてもらえると良いかもしれません。

 >ちまちまと関数入れてるよりもVBAだとほんとに一発変換ですね。 
 そうですね。今回の様なのはVBA向きだと思いますが
 作業列を使えば関数でも出来るんじゃないかと思います。

 たとえば
 >実際はもう少し番号を取っておいて、後で必要なかったら必要のない行数列数を非表示或いは削除したいと考えています。 
 の方式になりますが、データの方はE:I列を作業列にして↓のJ列の様な検索値を作っておいて
 	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]	[J]
  [ 1]	事業名	番号	氏名	所属	1	2	3	4	5	検索値
  [ 2]	新研究	1	田中	○○大	1					10000
  [ 3]	新研究	2	山田	○○大	1	1				11000
  [ 4]	新研究	2	池本	○○大	1	2				12000
  [ 5]	新研究	2	山本	△△	1		1			10100
  [ 6]	新研究	2	谷川	△△	1		2			10200
  [ 7]	新研究	4	佐藤	○○大	1			1		10010
  [ 8]	新研究	4	安田	○○大	1			2		10020
  [ 9]	新研究	4	竹本	△△	1				1	10001
  [10]	新研究	4	木村	△△	1				2	10002
  [11]	基盤A	1	澤田	△△	2					20000
  [12]	基盤A	2	岸本	○○大	2	1				21000
  [13]	基盤A	2	伊藤	○○大	2	2				22000
  [14]	基盤A	2	吉田	○○大	2	3				23000
  [15]	基盤A	2	加藤	△△	2		1			20100
  [16]	基盤A	2	津川	△△	2		2			20200
  [17]	基盤A	4	有村	○○大	2			1		20010
  [18]	基盤A	4	前田	○○大	2			2		20020
  [19]	基盤A	4	中村	△△	2				1	20001
  [20]	基盤A	4	光本	△△	2				2	20002

 1番目の A:B列は 10000 を検索
 2番目の A:B列は 20000 を検索

 1番目の学内分担者の1列目(C列)は 11000 を検索。2列目(D列)は 12000 を検索 ・・・
        学外分担者の1列目(E列)は 10100 を検索。2列目(F列)は 10200 を検索 ・・・
 ・・・・・・と言った具合に。

 まぁ、最初に数式を埋め込むのと「必要のない行数列数を非表示」が面倒ですが。
  
(HANA) 2015/02/23(月) 01:49

HANA様

ただただ感動するばかりですっ!!
驚きました。
これ毎年使えますよね?
毎年データは違っていて、研究数も変わってきますが、それも対応できますよね?

学外連携者、8人分きちんと来ていますものね。
すごい。
どの部分でそれを指定しているのかもわかりません(汗)
感動の一言でございます。

作業列を使えばっていうところは、この検索値をどのように使えばよいのでしょうか?

私は、関数しかあまり使えないので、(VBAはクリアコンテンツとか、ページアップ、オートフィルター、あとユーザーフォームなどは多少は使えるようになったのですが)
関数で作っていたのです。
しかしそれだと縦列にしか並んでこないのでそれで横列に変換したいと思ってこちらにお伺いした次第です。
でも以前、支払明細の件で質問させていただいたときも作業列をたくさん展開する手法を教えて頂きましたよね。
あれからコツコツ使いながら関数はまあ使えるようにはなったかな?とは思っているのですが、まだまだ勉強が足りませんので、もう少しお時間にゆとりがございますようでしたら、この作業列を使ったやり方もご説明頂けたらとても嬉しいです。

(Ja2136) 2015/02/23(月) 12:49


 CSVシートの作業列に式を作って
 CSV	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]	[J]	
  [ 1]	事業名	番号	氏名	所属	事業	内分	外分	内連	外連	検索値	←見出しを入力
  [ 2]	新研究	1	田中	○○大	1	0	0	0	0	0100000000	
  [ 3]	新研究	2	山田	○○大	1	1	0	0	0	0101000000	
  [ 4]	新研究	2	池本	○○大	1	2	0	0	0	0102000000	
  [ 5]	新研究	2	山本	△△	1	0	1	0	0	0100010000	
  [ 6]	新研究	2	谷川	△△	1	0	2	0	0	0100020000	
  [ 7]	新研究	4	佐藤	○○大	1	0	0	1	0	0100000100	
  [ 8]	新研究	4	安田	○○大	1	0	0	2	0	0100000200	
  [ 9]	新研究	4	竹本	△△	1	0	0	0	1	0100000001	
  [10]	新研究	4	木村	△△	1	0	0	0	2	0100000002	
  [11]	基盤A	1	澤田	△△	2	0	0	0	0	0200000000	
  [12]	基盤A	2	岸本	○○大	2	1	0	0	0	0201000000	
  [13]	基盤A	2	伊藤	○○大	2	2	0	0	0	0202000000	
  [14]	基盤A	2	吉田	○○大	2	3	0	0	0	0203000000	
  [15]	基盤A	2	加藤	△△	2	0	1	0	0	0200010000	
  [16]	基盤A	2	津川	△△	2	0	2	0	0	0200020000	
  [17]	基盤A	4	有村	○○大	2	0	0	1	0	0200000100	
  [18]	基盤A	4	前田	○○大	2	0	0	2	0	0200000200	
  [19]	基盤A	4	中村	△△	2	0	0	0	1	0200000001	
  [20]	基盤A	4	光本	△△	2	0	0	0	2	0200000002	
					↑	↑	↑	↑	↑	↑	
					|	|	|	|	|	J2=TEXT(E2,"00")&TEXT(F2,"00")&TEXT(G2,"00")&TEXT(H2,"00")&TEXT(I2,"00")	
					|	|	|	|	I2=IF(AND($B2=4,$D2<>"○○大"),SUM(I1,1),0)		
					|	|	|	H2=IF(AND($B2=4,$D2="○○大"),SUM(H1,1),0)			
					|	|	G2=IF(AND($B2=2,$D2<>"○○大"),SUM(G1,1),0)				
					|	F2=IF(AND($B2=2,$D2="○○大"),SUM(F1,1),0)					
					E2=IF(B2=1,SUM(E1,1),E1)						

 結果を表示させるシートに、数式を埋め込む。
 Sheet2	[A]	[B]	[C]	[D]	[E]	[F]	[G]	[H]	[I]	[J]	[K]	[L]	[M]	[N]
  [ 1]	事業名	代表	内分1	内分2	内分3	外分1	外分2	外分3	内連1	内連2	内連3	外連1	外連2	外連3
  [ 2]	新研究	田中	山田	池本		山本	谷川		佐藤	安田		竹本	木村	
  [ 3]	基盤A	澤田	岸本	伊藤	吉田	加藤	津川		有村	前田		中村	光本	
	↑	↑	↑			↑			↑			↑		
	|	|	|			|			|			L2=IFERROR(INDEX(CSV!$C:$C,MATCH(TEXT(ROW($A1),"00")&"000000"&TEXT(COLUMN(A2),"00"),CSV!$J:$J,0)),"")		
	|	|	|			|			I2=IFERROR(INDEX(CSV!$C:$C,MATCH(TEXT(ROW($A1),"00")&"0000"&TEXT(COLUMN(A2),"00")&"00",CSV!$J:$J,0)),"")					
	|	|	|			F2=IFERROR(INDEX(CSV!$C:$C,MATCH(TEXT(ROW($A1),"00")&"00"&TEXT(COLUMN(A2),"00")&"0000",CSV!$J:$J,0)),"")								
	|	|	C2=IFERROR(INDEX(CSV!$C:$C,MATCH(TEXT(ROW($A1),"00")&TEXT(COLUMN(A2),"00")&"000000",CSV!$J:$J,0)),"")											
	|	B2=IFERROR(INDEX(CSV!$C:$C,MATCH(TEXT(ROW($A1),"00")&"00000000",CSV!$J:$J,0)),"")												
	A2=IFERROR(INDEX(CSV!$A:$A,MATCH(TEXT(ROW($A1),"00")&"00000000",CSV!$J:$J,0)),"")													
 C:Nが一つの式で済む様にも出来そうですが、今回はどうせマクロを使うと思うので。。。

 どこか空いたスペースに
 	内分	外分	内連	外連
	3	2	2	2
	↑			
	=MAX(CSV!F:F)			
 こんな表を作っておけば、外分・内連・外連は3列目が非表示で良いと簡単にわかると思います。

 作ったマクロは、データの不備を想定していませんので
 そのあたりの追加が必要になるかもしれません。

 >毎年データは違っていて、研究数も変わってきますが、それも対応できますよね?
 過去のデータをひっぱり出してきて、検証してもらえると良いと思います。
 不具合も見つかるかもしれません。
  
(HANA) 2015/02/23(月) 16:33

HANA様

こんばんは。
もの凄い関数の作業列・・・。
ありがとうございます。
1個1個の式を理解するのにこれまた時間がかかりそう〜ヽ(≧∀≦)ノ

しかしこれだけ作業列使ってうまくインデックスを作ってやれば、横列に取り出せるんですねぇ〜!!!
毎度ながら驚愕するしかないというか・・・。
う〜ん、物凄いです(汗)
ありがとうございます。
大切に、今後の参考とさせて頂きます。
こちらに投稿して教えて頂く内容は、お金を払って授業を受けに行くのよりまだ凄い、より実践で使えるモノを教えて頂けるので本当にありがたいです。
今日は少し忙しかったので過去のデータの検証ができませんでした。
明日させて頂きます。
不具合が出たら又ご報告させて頂きますね。
とりあえず、関数版のお礼まで。
(Ja2136) 2015/02/23(月) 21:21


HANA様

マクロの方、昨年度のデータはなかったのですが、今年度のデータに色々付け加えたりしてダミーで試してみましたが、可変の項目をちゃんとその通りに拾っているようです。
問題はなさそう・・・。
ありがとうございました。
素晴らしすぎて、何だか夢みたい・・・。

関数の方も少しずつ解読したいとは思っていますが、あんまり複雑すぎて全体像が掴めない〜(汗)
もっとも、こちらのVBAの方だってそうですけど(涙)

ともあれ、何とかなりそうなので、よかったです。
残念ながらこれを来年使うのは私ではないのですが、いつもあまりに忙しい部署なので少しでもお役に立てたらと思って、こちらにご相談差し上げました。
とても助かりました。

また色々わからないことがありましたら、ご相談させて頂きたいと思っております。

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

(Ja2136) 2015/02/24(火) 12:36


 >1個1個の式を理解するのにこれまた時間がかかりそう〜ヽ(≧∀≦)ノ 
 それぞれ式を入れる様になっていますが、基本的には繰り返しです。
  F2=IF(AND($B2=2,$D2="○○大"),SUM(F1,1),0)
  G2=IF(AND($B2=2,$D2<>"○○大"),SUM(G1,1),0)
   「○○大」かそうじゃないかだけの違い。

  A2=IFERROR(INDEX(CSV!$A:$A,MATCH(TEXT(ROW($A1),"00")&"00000000",CSV!$J:$J,0)),"")
                        ~~~~~       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   INDEX関数の範囲、MATCH関数での検索値だけの違い。

 今簡単に考えられるデータの不備は「1」がない場合 です。
 エラーになって止まるかもしれませんし
 止まらずに処理が進むが結果がおかしくなるかもしれません。

 完成したデータは、希望通りの結果になっているか
 確認してもらうようにしてください。
  
(HANA) 2015/02/25(水) 08:48

HANA様

こんばんは。
ようやく関数の方、頂いたデータでちゃんと来ることが確認できました。
遅くなってごめんなさい。
正規のデータでするとなると量が多いので大変でしょうが、とりあえず、きちんと来ることを確認しましたので、ちゃんとやってみます。
にしても・・・。
スゴイです!!
ぱらぱらと、縦列・横列ドラッグして名前が出てくる面白さ。
やっぱりこれは関数でないと味わえない醍醐味ですよねえ。
ありがとうございます。
感無量でございます。

一度お目にかかりたいものですね。
お茶ぐらいご馳走できたらいいのにな。
本当にありがとうございました。

(Ja2136) 2015/02/25(水) 23:26


 >正規のデータでするとなると量が多いので大変でしょうが、とりあえず、
 >きちんと来ることを確認しましたので、ちゃんとやってみます。 
 いや、やらなくて良いですよ。。。マクロの方を使うのでしょ?

 仕組みを理解して、次の機会に同じ仕組みを使ってもらえたら良いと思います。
   仕組みを理解するために、実際のデータでもやってみる というのなら
   止めはしませんが。

 >ぱらぱらと、縦列・横列ドラッグして名前が出てくる面白さ。 
 >やっぱりこれは関数でないと味わえない醍醐味ですよねえ。
 そうなんですよね。
 それから、マクロと違って実行のタイミングを気にしなくて良い とか
 「元に戻す」が使えるとか。
 まぁ、関数を使う事で起きる問題もありますが。。。

 どちらも程々に使えるようになると良いですね。
  
(HANA) 2015/02/26(木) 13:31

HANA様

コメント気づかず失礼致しました。
今回はマクロを使わせて頂きますが、この関数もあまりに凄いのでこちらもコツコツと
勉強させて頂きたいと思います。
お茶どころじゃないですよね?
ランチ1回分(それなりのところの)をご馳走するぐらいのご恩です。
(もっとか・・・)

実は関数も実際のデータを使って入れてみたのですが、(テストデータと同じ列数で・行数はすごい量なのでちょっと大変なんですが)
事業別・学内分担・学外分担他、テストデータと違って0しか返ってこないのです。
それでちょっと戸惑い・・・(汗)
マクロのコードと違って、こちらは行数やら列数で違いが出るわけでなく、
テストデータと同じ配置でやってるはずなんですが(涙)

う〜ん、なかなか難しいですね。
もう一度考え直した方がいいのかも?
マクロは結構、バグった時に直せないから嫌がる人が多いのです。
それで関数版も一応おいておこうかなって思ってたんですが・・・。
このところ仕事忙しくってなかなかできなくって・・・。

もう一度ちょっとやってみます。

(Ja2136) 2015/03/05(木) 12:39


コメント返信:

[ 一覧(最新更新順) ]


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