A列  B列   C列
1行目  佐藤 北海道 りんご

2行目  佐藤 北海道 ばなな
 
3行目 伊藤  東京  いちご

4行目  伊藤  東京  ばなな 

上記のようなデーターがあります。これを2行目と4行目を削除し下記のようにしたいのですが

      A列  B列      C列
1行目  佐藤 北海道  りんごばなな

2行目  伊藤  東京   いちごばなな

A列とB列のデーターが同じでC列のデータが異なる場合、上記のように一行にまとめたいのです。関数やVBAで上記の処理を出来る方法がありますでしょうか。 

このQ&Aに関連する最新のQ&A

A 回答 (4件)

VBAの一例です。


新たなシートを追加してそこにご希望の状態を表示させます。
ご提示のデータはA1から連続してあるものとします。

Sub test01()
Dim x As Long, i As Long, myStr As String
Dim vAK, vBK, vCI
Dim myDic As Object, ns As Worksheet
With Range("A1").CurrentRegion.Columns 'A1の連続範囲
x = .Rows.Count '行数取得
vAK = .Item(1).Value '1列目データ
vBK = .Item(2).Value '2列目データ
vCI = .Item(3).Value '3列目データ
End With
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To x '1行目から最終行まで
myStr = vAK(i, 1) & "^" & vBK(i, 1) '1列目データ+2列目データ
If Not myDic.Exists(myStr) Then 'myDicになければ
myDic.Add Key:=myStr, Item:=vCI(i, 1) '追加
Else 'あれば、3列目データを追加
myDic(myStr) = myDic(myStr) + vCI(i, 1)
End If
Next i
Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
With ns '転記して分離
.Cells(1, 1).Resize(myDic.Count).Value = Application.Transpose(myDic.Keys) '
.Cells(1, 3).Resize(myDic.Count).Value = Application.Transpose(myDic.Items) '
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Other:=True, OtherChar _
:="^", FieldInfo:=Array(Array(1, 1), Array(2, 1))
End With
End Sub
    • good
    • 1
この回答へのお礼

多くのデーターの処理にたいしても、時間が殆どかからず出来ました。助かりました。有難うございます。

お礼日時:2009/05/14 17:12

VBAでないと難しいと思いますので一例です。

(E・F・G列に展開します)
(1)対象のシートタブ上で右クリック→コード表示
(2)以下のコードを貼り付け
Sub データ統合()
Dim a, e As Range
For Each a In Range("A:A")
If a.Value = "" Then Exit Sub
For Each e In Range("E:E")
If e.Value = "" Then
Range("E1").Offset(e.Row - 1) = a
Range("F1").Offset(e.Row - 1) = Range("B1").Offset(a.Row - 1)
Range("G1").Offset(e.Row - 1) = Range("C1").Offset(a.Row - 1)
Exit For
Else
If e = a And Range("F1").Offset(e.Row - 1) = Range("B1").Offset(a.Row - 1) Then
x = InStr(1, Range("G1").Offset(e.Row - 1), Range("C1").Offset(a.Row - 1), vbTextCompare)
If x > 0 Then Exit For
Range("G1").Offset(e.Row - 1) = Range("G1").Offset(e.Row - 1) & Range("C1").Offset(a.Row - 1)
Exit For
End If
End If
Next
Next
End Sub
(3)VBEを終了(Alt+F4キー押下)
    • good
    • 0

まず一旦、B列のグループごとに集計し直して そこから作業を始めてはいかがですか?



フィルタで「北海道」を抽出して「シート北海道」にまとめて移すとか。

あとは 「北海道でりんごが2件も3件もあったらどうするのか」等々
場合により処理の仕方が変わると思うのですが。。。

まぁ どちらにせよ一旦「作業用シート」で作業を行って元のシートに戻せば関数もVBAも必要ないですね。
    • good
    • 0

とりあえず、VBAでの一例です。



Sub test()
Dim rmax As Long, rw As Long, r As Long
Dim v1 As String, v2 As String, st As String

rmax = Cells(Rows.Count, 1).End(xlUp).Row
For rw = 1 To rmax - 1
 st = Cells(rw, 3).Text
 v1 = Cells(rw, 1).Value
 If v1 <> "" And v1 <> Chr(27) Then
  v2 = Cells(rw, 2).Value
  For r = rw + 1 To rmax
   If Cells(r, 1).Value = v1 And Cells(r, 2).Value = v2 Then
    st = st & Cells(r, 3).Text
    Cells(r, 1).Value = Chr(27)
   End If
  Next r
  Cells(rw, 3).Value = st
 End If
Next rw
For r = rmax To 1 Step -1
 If Cells(r, 1).Value = Chr(27) Then Cells(r, 1).Resize(1, 3).Delete (xlShiftUp)
Next r
End Sub
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qword2000の薄い行線の消し方

word2000とword2002を使用していますが2000の方は薄い行線がでてうっとうしいのですが消せないのでしょうか?2002の方はでません。

Aベストアンサー

薄い行線? これは入力画面に出ている線でしょうか?
画面上方のメニューバーの「表示」→「グリッド線」のチェックを外すとOKです。

Qエクセルの関数です。一列目で指定した値の間で、二列目で指定した値を示す、一列目の最初の値を求める。

エクセルの関数です。
一列目で指定した値の間で、二列目で指定した値を示す、一列目の最初の値を求める関数を教えてください。
添付した図で、具体的に説明します。
A列に値(時間)、B列に値があります。
この配列の中から、
F4の値(時間)と同じ値(時間)を示すA列の行から、F5の値(時間)と同じ値(時間)を示すA列の行までの中で、
F3の値と同じ値がB列にある、A列の値(時間)の内、
A列で上から最初の値(時間)
です。

min、offset、index、match を組み合わせてみるのですが、うまくいきません。
どうぞよろしくお願いします。

Aベストアンサー

こんにちは!

画像の配置でF6セルに「7」という結果が返れば良い訳ですかね?

少し長くなりますが、
=INDEX(INDIRECT("A"&MATCH(F4,A:A,0)&":A"&MATCH(F5,A:A,0)),MATCH(F3,INDIRECT("B"&MATCH(F4,A:A,0)&":B"&MATCH(F5,A:A,0)),0))
という数式を入れてみてください。

※ F3セルは質問に載っていないので余計なお世話かもしれませんが
同じようなやり方で
=MAX(INDIRECT("B"&MATCH(F1,A:A,0)&":B"&MATCH(F2,A:A,0)))
という数式になると思います。

※ エラー処理はしていません。m(_ _)m

QMindjet:スプレッドシートの行・列の消し方

Mindjet(http://www.mindjet.com/jp/)というマインドマップをつくるソフトを利用しています。トピックの横に表を挿入する為、「スプレッドシート」を入れたのですが、表の横に行(A/B/C/D)と列(1/2/3)の表示(灰色の部分)が残ってしまい、あまり見栄えがよくありません。行・列の表示を消す方法をご存知の方がいれば、ご教示頂けると助かります。

Aベストアンサー

こんばんは。

スプレッドシートと書かれていますが、Excelの問題をお聞きになっているものだと思います。もし、そうだとすれば、

ツール-オプション-表示
ウィンドウオプション
 行列番号

をオフにするでいかがでしょうか?これは、シートごとです。

しかし、もしかしたら、その現象は、別の問題(物理的=ハード)が絡んでいるかもしれません。もし、そうだとすると、これでは解決しないかもしれません。

Q10行目が見出しです。 E列11行目から下方にデータが無ければ データがありません。のメッセージが出

10行目が見出しです。
E列11行目から下方にデータが無ければ
データがありません。のメッセージが出てマクロ終了。
一つでも入っていたらマクロ続行。
と、いうマクロを教えてください。
よろしくお願いします。
エクセル2013

Aベストアンサー

こんにちは!

今行っている処理の前に↓の4行のコードを追加してみてはどうでしょうか?

If Cells(Rows.Count, "E").End(xlUp).Row = 10 Then
MsgBox "データなし"
Exit Sub
End If

Qニキビの消し方

誰かニキビの消し方を教えてください
私はまだ小六ですがニキビが出ています
詳しく、1、2、などの順序で、短日で消えるニキビ消し方教えてください

Aベストアンサー

こんにちは。
私は26歳の女です。
小六位から私もニキビが出始めました。

私がお答えするのはニキビの消し方ではなく、
根本的にニキビをできにくくする方法です。

(1)しっかり洗顔
洗顔料をしっかり泡立てて両手で円を描くように。
直接手が肌に触れないように。泡で毛穴を洗うイメージです。
できれば洗顔前に20分位湯船につかって毛穴を開かせてから洗うと効果的です。

(2)洗顔料を完全に洗い流す
洗顔料が残っているとニキビの原因アクネ菌の栄養になってしまいます。
洗い流す時は強いシャワーをあてたり、ゴシゴシ強くこすったりしないで、
ぬるま湯をかけて念入りに流します。タオルドライもやさしくポンポンと。

これでだいぶニキビができにくくなると思いますよ♪

QA列(10行)とB列(10行)の全ての組み合わせをC列にリストアップしたい。

何度もすみません。
前回の質問で文字列の組み合わせの方法は理解いたしました!
本当にありがとうございます。

追加で質問になるのですが、タイトルにあるように(※数字は仮です)

A列(10行)とB列(10行)の全ての組み合わせをC列にすべて(100行?)リストアップしたいと考えています。

また並び方は
A1
A2
A3



B1
B2



というようにしたいです。
このようにするには

C列にどのような関数を入れればいいのでしょうか?
どうかよろしくお願いいたします。

Aベストアンサー

#3,#4です
C1セルに
=IF(COUNTA(A:A)*COUNTA(B:B)<ROW(),"",
INDEX(A:A,(ROW()-1)/COUNTA(B:B)+1)&" "
&INDEX(B:B,MOD(ROW()-1,COUNTA(B:B))+1))
で良かったです。余計なものを足してました。
添付図、薄い緑は手入力です。水色には数式が入っています
D、E列のような数値が求められれば、(INDEX関数を使って)結果が出せるのはわかるでしょうか?

以下、その数値を求める方法です。
素材として連番があります。

F列は、行番号です。F1セルに =ROW()

G列は、連番をB列の個数で割ったものです。
求めたい値を出すために (連番-1)/B列の個数 +1 としています
G1 =(F1-1)/COUNTA(B:B)+1
=INT((F1-1)/COUNTA(B:B)+1)とすれば求めたい値になります。

H列は連番をB列の個数で割った余りです。
求めたい値を出すために((連番-1)/B列の個数)のあまり +1 としています
F1 =MOD(F1-1,COUNTA(B:B))+1

I1セル =INDEX(A:A,G1)
J1セル =INDEX(B:B,H1)
としてA列、B列の値を引っ張ってきます。
ここでINDEXの第2引数ですが、小数になっている場合切り捨てられて計算されるので、INTを追加しなくても良いです。
わかりにくくなる可能性を加味してINTを加えても良いでしょう。

ある程度の説明はしたつもりですが、それでもわからない点があれば再度質問してください

#3,#4です
C1セルに
=IF(COUNTA(A:A)*COUNTA(B:B)<ROW(),"",
INDEX(A:A,(ROW()-1)/COUNTA(B:B)+1)&" "
&INDEX(B:B,MOD(ROW()-1,COUNTA(B:B))+1))
で良かったです。余計なものを足してました。
添付図、薄い緑は手入力です。水色には数式が入っています
D、E列のような数値が求められれば、(INDEX関数を使って)結果が出せるのはわかるでしょうか?

以下、その数値を求める方法です。
素材として連番があります。

F列は、行番号です。F1セルに =ROW()

G列は、連番をB列の個数で割ったものです。
...続きを読む

Q履歴の消し方

パソコンでよく検索するのですが、その履歴の消し方が分かりません。履歴が一杯残ってしまい困っています。
消し方を教えてください。宜しくお願いします。

Aベストアンサー

検索項目を入れるボックスで右クリック

過去に入力したワードが出てくるのでそれにカーソルを合わせて青地にワードが入っている状態にする。

あとは「Delete」ボタンをひたすら押すだけ。押しっぱなしだと失敗することもあるかも

私は以上の方法でやってますが・・・。
たぶんこれでいけると思います。

Q行のデータ(a列b列c列)をd列に表示したい

a1、b1、c1のセルに入力したデータをd1セルに表示したい。可能でしょうか。一例「a1セルに1と入力、b1セルに2と入力、c1セルに3と入力しd1セルに123と表示する」

Aベストアンサー

d1セルに =a1&b1&c1

エクセルですよね?

Qデスクトップにでてくる広告の消し方

パソコンをリカバリしたら、デスクトップにFMVの広告がいっぱい出てきました。
パソコンにはあまり詳しくないので消し方が解りません。
消し方を教えてください。

Aベストアンサー

下記FAQ参照

https://www.fmworld.net/cs/azbyclub/qanavi/jsp/qacontents.jsp?rid=168&PID=6006-1809

QエクセルでA列の数値にB列以降の列の数値を乗じて各列の最終行に合計を出したい

エクセルで集計をしたいのです。
うまく説明できませんが教えてください。
列数が100列以上ある集計表です

A列の1~20行の固定した数値にB列~100列以上の1~20行の各列の数値を乗じてそれぞれの列の合計をそれぞれの列の21行目に出したいのですがどうしたらいいか教えてください。

Aベストアンサー

B21に
=SUMPRODUCT($A$1:$A$20,B1:B20)
とします。後は横にコピーします。


人気Q&Aランキング