エクセルの計算式及びその応用について教えてください。

A data1
A data2
A data3
B data1
B data3
C data2
C data4
C data5
と、データがあるとします。(スペースで分けてあるものは別のセルです。)
このデータを計算式と貼り付けをして、下記のようなデータにしたいのです。
データ量は膨大なため、出来る限りそれぞれ一括でできる方法をお教え頂けますと幸いです。
A data1:data2:data3
B data1:data3
C data2:data4:data5

先日エクセルについて教えて頂いたのがとても参考になりましたので、
エクセルに詳しい方、もし可能でしたらお教え頂けますと幸いです。
説明に時間もかかると思いますので、ポイントは多めで考えています。よろしくお願いいたします。

回答の条件
  • URL必須
  • 1人3回まで
  • 登録:2009/06/15 16:18:25
  • 終了:2009/06/15 18:30:39

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/06/15 18:13:34

ポイント450pt

VBAは使えますでしょうか。


VBAとはなんぞやという場合はこちらを参考に挑戦してみてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


以下のコードは、Sheet1の左上詰めにあるデータを変換してSheet2に表示するマクロです。

標準モジュールを追加してコピペして実行してみてください。

Sub Macro()
    Dim i As Long
    Dim j As Long
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim str1 As String
    Dim str2 As String
    Dim f As Boolean
    
    'シート1の最終行の取得
    lastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'ここのSheet2を変更することで結果を別の名前のシートにすることができます。
    With Worksheets("Sheet2")
    
        'シート1を1行目から最終行までループ
        For i = 1 To lastRow1
            
            'str1にA列、str2にB列を代入
            str1 = Worksheets("Sheet1").Cells(i, 1).Value
            str2 = Worksheets("Sheet1").Cells(i, 2).Value
            f = False
            
            '最初のデータはそのまま書き込み
            If .Cells(1, 1).Value <> "" Then
                
                'シート2の最終行の取得
                lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
                
                'シート2をループ
                For j = 1 To lastRow2
                
                    'A列と同じデータがあれば書き込み
                    If .Cells(j, 1).Value = str1 Then
                        .Cells(j, 2).Value = .Cells(j, 2).Value & ":" & str2
                        f = True
                        Exit For
                    End If
                Next j
            End If
            
            '同じデータが無かった場合f=False
            If f = False Then
                .Cells(lastRow2 + 1, 1).Value = str1
                .Cells(lastRow2 + 1, 2).Value = str2
            End If
        Next i
    End With
End Sub

わからないことがあればコメント欄で対応します。

id:derkrebs

とても難しい内容ですが、がんばって理解してみようと思います。ありがとうございました。

2009/06/15 18:27:28

その他の回答(2件)

id:taknt No.1

きゃづみぃ回答回数13537ベストアンサー獲得回数11982009/06/15 17:19:56

ポイント100pt

Aの場合

A data2

A data3

の dataの部分をコピーして

A data1の次のセルに 右クリックして

形式を選択して貼り付け、

行列を入れ替える にチェックを入れて OKとします。

で 不要になった

A data2

A data3

の部分を削除すればいいでしょう。

ちょっと大変ですが、これを 繰り返していけばいいでしょう。

http://q.hatena.ne.jp/answer

id:derkrebs

ありがとうございます。それと似たようなことを繰り返していたら

1時間後には半泣きでした。

2009/06/15 18:27:06
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/06/15 18:13:34ここでベストアンサー

ポイント450pt

VBAは使えますでしょうか。


VBAとはなんぞやという場合はこちらを参考に挑戦してみてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


以下のコードは、Sheet1の左上詰めにあるデータを変換してSheet2に表示するマクロです。

標準モジュールを追加してコピペして実行してみてください。

Sub Macro()
    Dim i As Long
    Dim j As Long
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim str1 As String
    Dim str2 As String
    Dim f As Boolean
    
    'シート1の最終行の取得
    lastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    'ここのSheet2を変更することで結果を別の名前のシートにすることができます。
    With Worksheets("Sheet2")
    
        'シート1を1行目から最終行までループ
        For i = 1 To lastRow1
            
            'str1にA列、str2にB列を代入
            str1 = Worksheets("Sheet1").Cells(i, 1).Value
            str2 = Worksheets("Sheet1").Cells(i, 2).Value
            f = False
            
            '最初のデータはそのまま書き込み
            If .Cells(1, 1).Value <> "" Then
                
                'シート2の最終行の取得
                lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
                
                'シート2をループ
                For j = 1 To lastRow2
                
                    'A列と同じデータがあれば書き込み
                    If .Cells(j, 1).Value = str1 Then
                        .Cells(j, 2).Value = .Cells(j, 2).Value & ":" & str2
                        f = True
                        Exit For
                    End If
                Next j
            End If
            
            '同じデータが無かった場合f=False
            If f = False Then
                .Cells(lastRow2 + 1, 1).Value = str1
                .Cells(lastRow2 + 1, 2).Value = str2
            End If
        Next i
    End With
End Sub

わからないことがあればコメント欄で対応します。

id:derkrebs

とても難しい内容ですが、がんばって理解してみようと思います。ありがとうございました。

2009/06/15 18:27:28
id:jccrh1 No.3

jccrh1回答回数111ベストアンサー獲得回数192009/06/15 18:17:19

ポイント450pt

マクロを使用しないと難しいと思います。

 

次の条件でマクロを作成してみました。

・Sheet1のA1~Bnに集計したいデータ

・Sheet2のA1~Bnに集計した結果

 並べ替えや列幅を自動設定しています。

Sub 集計処理()
  Set グループ = CreateObject("Scripting.Dictionary")
  
  ' Sheet1を集計
  Set 集計範囲 = Sheets("Sheet1").UsedRange
  For I = 1 To 集計範囲.Rows.Count
    Key = 集計範囲(I, 1).Value
    DATA = 集計範囲(I, 2).Value
    If グループ.Exists(Key) Then
      グループ(Key) = グループ(Key) & ":" & DATA
    Else
      グループ(Key) = DATA
    End If
  Next I
  
  ' Sheet2に出力
  Sheets("Sheet2").Select
  Cells.Clear
  Keys = グループ.Keys
  For I = 0 To グループ.Count - 1
    Cells(I + 1, 1) = Keys(I)
    Cells(I + 1, 2) = グループ(Keys(I))
  Next I
  Cells.EntireColumn.AutoFit
  Cells.Sort Key1:=Range("A1")
End Sub

ダミーURL:http://q.hatena.ne.jp/1245050304

id:derkrebs

ありがとうございます。マクロについては勉強が足りず、詳しくはわかりませんが、お二人から頂いたご意見を参考に

いろいろと挑戦してみようと思います。

2009/06/15 18:28:53
  • id:derkrebs
    ありがとうございました。凄い単純な計算式とコピーだけでいけると勝手に思い込んでいたので、ものすごい複雑な書式が出てきて驚いてます。
    どちらの内容がより理想的な内容かすらわからないので、先にお応え頂いた方にいるか、お二人ともに同じポイントを入れさせて頂きました。
  • id:kia_44
    あえてVBA使わない方法思いついたので書いてみます。
    data1~data(n)が重複しないならばこの方法で。

    以下説明のため
    フィールドA フィールドB
    a data1
    b data2
    c data3
    ということで・


    ・ピボットテーブルを使います

    フィールド1を縦軸
    フィールド2を横軸
    フィールド2をカウントでピボットテーブル作成

    ピボットテーブル自体を値としてコピー
    (A2からF5まで縦項目、B2からB5までが横項目になったとする)
    (カウント値はデータがあれば1となっています)

    縦軸のA2からA5だけをA6にコピー

    B6に、=if(B2=1,B$1,"")と式を設定する。そしてフィル。すると、空白を含むがフィールド2があれば
    a,data1,data2,"",data4といったデータが出来上がる

    これを新しいエクセルにコピペ。

    CSV形式カンマ区切りにて保存

    メモ帳で開く

    置換を使用し、,,を,に置き換える

    ,,がなくなるまでやる。(ここがめんどくさそう)

    エクセルで開いたらちゃんとできてる。
  • id:derkrebs
    kia_44様
    わかりやすい方法をお教え頂きまして、誠にありがとうございます。すぐに締めきってしまったために、ちゃんとしたお礼もできず誠に恐縮です。エクセルはどう頑張っても、私の能力(頭)では理解の限界があるので、今後こちらのはてなを通じてお伺いさせて頂く事が多いと思います。その際は、またいろいろとお教え頂けますと光栄です!

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

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

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

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