Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8179 / 13644 ツリー ←次へ | 前へ→

【34644】複数にわたるデータを一行に纏める方法 初心者m(__)m 06/2/9(木) 9:31 質問[未読]
【34649】Re:複数にわたるデータを一行に纏める方法 ちくたく 06/2/9(木) 10:31 発言[未読]
【34674】Re:複数にわたるデータを一行に纏める方法 初心者m(__)m 06/2/9(木) 16:56 お礼[未読]
【34658】Re:複数にわたるデータを一行に纏める方法 Kein 06/2/9(木) 13:34 回答[未読]
【34673】Re:複数にわたるデータを一行に纏める方法 初心者m(__)m 06/2/9(木) 16:53 お礼[未読]
【34784】Re:複数にわたるデータを一行に纏める方法 初心者2 06/2/12(日) 15:07 質問[未読]
【34786】Re:複数にわたるデータを一行に纏める方法 Kein 06/2/12(日) 18:01 発言[未読]
【34789】Re:複数にわたるデータを一行に纏める方法 初心者2 06/2/13(月) 7:48 質問[未読]
【34787】Re:複数にわたるデータを一行に纏める方法 Hirofumi 06/2/12(日) 18:50 回答[未読]

【34644】複数にわたるデータを一行に纏める方法
質問  初心者m(__)m E-MAIL  - 06/2/9(木) 9:31 -

引用なし
パスワード
   すみません、今途方にくれています。
どなたか教えて頂けると大変助かります。

↓与えられたデータ

データ名1        xxx
xxxデータの合計        500         
xxxデータの内訳1             200
xxxデータの内訳2             100
xxxデータの内訳3             100    
xxxデータの内訳4             100
データ名2        yyy
yyyデータの内訳1    350         
yyyデータの内訳3             150
yyyデータの内訳5             200
データ名3        zzz
zzzデータの内訳1    1550         
zzzデータの内訳2             150
zzzデータの内訳3             100
zzzデータの内訳4             800
zzzデータの内訳5             200
zzzデータの内訳6             300
------------------------------------以下20000行くらい続く

以上のデータを一行にまとめた以下のデータするには、どのようなマクロを組めばいいでしょうか?

データ名    データの合計    データの内訳1    データの内訳2    データの内訳3---続く
データ1        500        200        100        100


オートフィルタ、集計やピボットなどで試してみましたが
うまくいかず本当に困っています。
よろしくお願いいたします。


データ2        100

【34649】Re:複数にわたるデータを一行に纏める方法
発言  ちくたく E-MAILWEB  - 06/2/9(木) 10:31 -

引用なし
パスワード
   初心者m(__)m さん
こんにちは。

マクロで片づけたいのでしたら、
詳細な仕様が必要です。
それぞれのデータは何列(A列とか)か、
内訳1という名前は使われているのか、
また、内訳は何個なのか、とか。
ちょっと、そこらへんが不明確だと、書けないのです。

>以上のデータを一行にまとめた以下のデータするには、どのようなマクロを組めばいいでしょうか?

と、いうわけで考え方だけしか書けないのですが、
ちょっと長ったらしいコードになりそうですが、
新しいシートを用意して、
各データ名ごとに、
内訳の名称でデータを捕まえて、
そのシートに飛ばす、というループで処理するですかねぇ。

なんか、データベース系の人なら、
もっとうまいやり方知っているかもですが。

【34658】Re:複数にわたるデータを一行に纏める方法
回答  Kein  - 06/2/9(木) 13:34 -

引用なし
パスワード
   Sheet1 にその表があって、Sheet2(空白シート) に転記するとします。
以下のコードを試してみて下さい。速度は特に考慮していませんが、20000行でも
それほど遅いとは感じないはずです。

Sub Test_Align()
  Dim MyR1 As Range, MyR2 As Range, C As Range
  Dim i As Long, x As Long
  Dim CkV As String, MyV As Variant
 
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
   With .Range("A1", .Range("A65536").End(xlUp)).Offset(, 26)
     .Formula = "=IF(MID($A1,4,1)=""名"",1,""A"")"
     Set MyR1 = .SpecialCells(3, 1)
     Set MyR2 = .SpecialCells(3, 2)
     .ClearContents
   End With
   Intersect(MyR1.EntireRow, .Range("A:A")) _
   .Copy Sheets("Sheet2").Range("A2")
  End With
  Sheets("Sheet2").Range("B1:H1").Value = Array("合計", "内訳1", _
  "内訳2", "内訳3", "内訳4", "内訳5", "内訳6"): i = 2
  For Each C In MyR2.Areas
   CkV = C.Offset(, -26).Range("A1").Value
   MyV = WorksheetFunction.Transpose(C.Offset(, -25).Value)
   If Right$(CkV, 2) = "合計" Then
     x = 2
   Else
     x = 3
   End If
   Sheets("Sheet2").Cells(i, x).Resize(, UBound(MyV)).Value = MyV
   i = i + 1
  Next
  Application.ScreenUpdating = True
  Set MyR1 = Nothing: Set MyR2 = Nothing
End Sub

【34673】Re:複数にわたるデータを一行に纏める方法
お礼  初心者m(__)m E-MAIL  - 06/2/9(木) 16:53 -

引用なし
パスワード
   ▼Kein さん:

本当にありがとうございます。
参考にさせて頂きます。

【34674】Re:複数にわたるデータを一行に纏める方法
お礼  初心者m(__)m E-MAIL  - 06/2/9(木) 16:56 -

引用なし
パスワード
   ▼ちくたく さん:

ありがとうございます。
実はサンプルよりずっと複雑なんです。

とりあえず同じフィールドに同じデータが並ぶ
ようデータベース化できればAccessを使えるんですが、、
なんでこんな処理し難い形にしてあるのか・・

もう困ってしまって死にそうです。。

取り急ぎ、ヒントいただき有難うございました。

【34784】Re:複数にわたるデータを一行に纏める方法
質問  初心者2 E-MAIL  - 06/2/12(日) 15:07 -

引用なし
パスワード
   ▼Kein さん:

時間が経ってしまいましたが、自分で改良しても
うまくいかず、お手数ですがもう一度教えていただけ
ないでしょうか?

>   With .Range("A1", .Range("A65536").End(xlUp)).Offset(, 26)

この26という数字はなんでしょうか?

>     .Formula = "=IF(MID($A1,4,1)=""名"",1,""A"")"

データ名が電話番号なんですが、上の部分はどのように
書いたらいいでしょうか?
>  Sheets("Sheet2").Range("B1:H1").Value = Array("合計", "内訳1", _
>  "内訳2", "内訳3", "内訳4", "内訳5", "内訳6"): i = 2

この"内訳1"などは、長い文で入っているのですが、
(例えば"今月は内訳1の料金です。"等)
文頭、もしくは文中に入っている場合、どのように
対象とすればいいでしょうか?

大変申し訳ありませんが、至急教えていただけると
大変助かります。

【34786】Re:複数にわたるデータを一行に纏める方法
発言  Kein  - 06/2/12(日) 18:01 -

引用なし
パスワード
   >26という数字はなんでしょうか
特に意味はありません。これは「元データの行範囲のみを取得し、そこから"何も入力
されていないと推測される列"までのOffset値を勝手に指定している」のです。
その列を作業列として、判定用の数式を入力するためなのですが、"26列右" というのは
ちょうどアルファベットの数だけ右の列になりますから、仮に基準列がC列なら AC列、
E列なら AE列というように、頭に A を追加した列になって分かりやすいので、
そうしているのです。ここでもちろん AA列以降も使用中であれば、.Offset(, 52)
として BC列、BE列を作業列にすれば良い、というわけです。
>データ名が電話番号なんですが、上の部分はどのように書いたらいい
サンプルを書いて下さい。その際、「局番が何桁分あるか」が問題になりますから
2桁、3桁、4桁・・とあるなら、そのようにお知らせください。
>文頭、もしくは文中に入っている場合、どのように対象とすればいい
そこは特に、元の項目と一致させるとか文中の一部を取り出すとかするのでなく、
あくまで「元の項目を連想させられれば良い」ということで、短い文字列にして
いるのです。だから、もし簡単に連想ができないほど規則性が乏しい(例えば
必ずしも全ての文に"内訳"などの共通した語句がないなど)の場合は、意図的に
それを作ってでも、短いキーワードで一意に判別が出来るように工夫するべきです。
項目の存在意義というか役割というのは、まさにそれに尽きるからです。
さらにプログラミング的な考え方でも「規則性のないデータをループ処理するために
それらのデータを配列に入れる」という工夫をするのは定石なのです。
そーいう点で、もし現状では不都合に思えたら、ご自分で元データに手を入れて
改良してみて下さい。むしろそのような努力こそ、プログラミングの考え方を
身に付ける良い材料になると思います。

【34787】Re:複数にわたるデータを一行に纏める方法
回答  Hirofumi  - 06/2/12(日) 18:50 -

引用なし
パスワード
   データシートの内容が殆ど解らないので上手く行くかは?だけど作って見ました
一応、A列、B列の1行目からデータが有る物としています
また、内訳が、列見出しに出力する物以外が出た場合、無視されます

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim lngRow As Long
  Dim lngColumn As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim rngResult As Range
  Dim vntColumns As Variant
  Dim strProm As String
  
  '結果出力Listの左上隅セル位置を基準として設定(見出しの「データ名」のセル位置)
  Set rngResult = Worksheets("Sheet2").Cells(1, "A")
  With rngResult
    '行見だしを保持する配列を仮に確保
    ReDim vntRows(0)
    '列見だしを配列に取得(実際に含まれる文字列に修正する事)
    vntColumns = Array("合計", "内訳1", "内訳2", "内訳3", "内訳4", "内訳5", "内訳6")
    '列見だしを出力
    .Value = "データ名"
    .Offset(, 1).Resize(, UBound(vntColumns) + 1).Value = vntColumns
  End With
  
  'データListの左上隅セル位置を基準として設定
  Set rngList = Worksheets("Sheet1").Cells(1, "A")
  With rngList
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
    'データが無い場合
    If lngRows <= 1 And .Value = "" Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'データを配列に取得
    vntData = .Resize(lngRows, 2).Value
  End With
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '集計
  For i = 1 To lngRows
    'A列の値に"データ名"が含まれる場合(実際にセルに書いて有る値に含まれる文字列にする事)
    If InStr(1, vntData(i, 1), "データ名", vbTextCompare) > 0 Then
      '出力行を更新
      lngRow = lngRow + 1
      'データ名を結果シートに出力
      rngResult.Offset(lngRow).Value = vntData(i, 2)
    Else
      'A列の値が、どの内訳に当たるか探索
      lngColumn = GetColumnPos(vntData(i, 1), vntColumns)
      '該当する内訳が有った場合
      If lngColumn > 0 Then
        '結果シートにB列の値を書き込む
        rngResult.Offset(lngRow, lngColumn).Value = vntData(i, 2)
      End If
    End If
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

Private Function GetColumnPos(vntKey As Variant, _
              vntScope As Variant) As Long

  Dim i As Long
  Dim lngListEnd As Long
  
  '行見出しの行数を取得
  lngListEnd = UBound(vntScope, 1)
  '範囲からKeyを探索
  For i = 0 To lngListEnd
    'もし、行見出しと探索Keyが合致したら戻り値として行位置を返す
    If InStr(1, vntKey, vntScope(i), vbTextCompare) > 0 Then
      GetColumnPos = i + 1
      Exit Function
    End If
  Next i

End Function

【34789】Re:複数にわたるデータを一行に纏める方法
質問  初心者2 E-MAIL  - 06/2/13(月) 7:48 -

引用なし
パスワード
   ▼Kein さん:

投稿者です。
ご親切に回答頂きありがとうございました。


>サンプルを書いて下さい。その際、「局番が何桁分あるか」が問題になりますか

0xx-yyyy-zzzz
13桁となっております。


>あくまで「元の項目を連想させられれば良い」ということで、短い文字列にして

わかりました。
「内訳1」とういう文字を探して拾い出すわけじゃないんですね。
極端な話、自分だけがわかればいいと、、
意味がわからず恥ずかしいです。
ただ、サンプルでいう内訳が20種類以上ある場合でも
大丈夫でしょうか?
また、データ5では内訳6しかなく、データ8では内訳1から20まで
全部あるといった場合でも動くのでしょうか。

途中まででも動けば自分で確認できるのですが、、
大変申し訳ありません。

8179 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free