このような行の集計（統一）方法はありますか？。

質問

次のような行の集計（統一）をしたいのですが、できる方法があればご教示ください。
　　統一は方法は、関数でも、マクロでもかまいません。
　　予めA列でソートを行っており、行は5行目からとなります。

　　ソートの結果、下記のような
　　5行目６行目７行目のあA列が同じであるため、5行目と6行目7行目の数字は合計、
　　文字はそのまま表示とした統一方式です。
　　なお、BCD列の文字列には必ず１列にしか文字は入りせん。
　　また、結果を別シートに統一でもかまいません。

列　　　　A　　B　　C　　D　　E　　F　　G　　　　　　　　　　　　
5行目　　あ　い　　 　　 　　 　1　　3　　4
6行目　　あ　　　　か　　　　　3　　5　　6
7行目　　あ　　　　　　　き　　1　　2　　1
　↓
結果　　　あ　い　か　き　　5　　10　　11

　　行は；5行目から５００行ほどあり、A列の同一項目行が２行であったり、４行であったり、
　　また、単一の行もあるなど、バラバラです。

　　要は、A列が同じ行は一行に統一したいのです。
　　どなたか、よろしくお願いします。

回答No.6

tom04 · ベストアンサー

親の敵のように何度も顔を出してごめんなさい。

前回のコードでは不具合があると思います。

＞.AutoFilterMode = False
＞.ShowAllData

の2行を
＞Range(.Cells(5, 1), .Cells(endRow, 1)).Copy wS2.Cells(1, 1)
と
＞For i = 1 To wS2.Cells(Rows.Count, 1).End(xlUp).Row
の間に移動させてください。

B～D列のデータが正しく表示されない可能性があります。

どうも失礼しました。m(_ _)m

お礼

お礼が遅くなりました。申し訳ありません。
度々のご教示ありがとうございました。

最初の部分は良かったのですが、列Vまでの中に入っているセルの中には数字と文字が混在しているののもあるなどで、
思うように統一ができませんでした。

また、入力データを違った形にするなど考え直して、ご教示いただいたものを利用させていただきます。
本当にありがとうございました。

回答No.7

KURUMITO

関数で対応することもできます。マクロではデータが更新されるたびに操作をしなければなりませんが、関数ではその必要もなく自動的に更新されます。
シート１にデータが有るとして作業列としてＷ５セルには次の式を入力して下方にドラッグコピーします。

=IF(A5="","",IF(COUNTIF(A$5:A5,A5)=1,MAX(W$4:W4)+1,INDEX(W$4:W4,MATCH(A5,A$4:A4,0))))

Ｘ５セルには次の式を入力して下方にドラッグコピーします。

=IF(A5="","",W5+IF(B5<>"",0.1,0)+IF(C5<>"",0.2,0)+IF(D5<>"",0.3,0))

お求めの表をシート２に表示させるとしてシート２のＡ５セルには次の式を入力して右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>MAX(Sheet1!$W:$W),"",IF(COLUMN(A1)=1,INDEX(Sheet1!$A:$A,MATCH(ROW(A1),Sheet1!$W:$W,0)),IF(COLUMN(A1)<=4,IF(COUNTIF(Sheet1!$X:$X,TRIM(ROW(A1)+0.1*COLUMN(A1)-0.1)*1)=0,"",INDEX(Sheet1!$A:$G,MATCH(TRIM(ROW(A1)+0.1*COLUMN(A1)-0.1)*1,Sheet1!$X:$X,0),COLUMN(A1))),IF(COLUMN(A1)<=7,SUMIF(Sheet1!$W:$W,ROW(A1),Sheet1!A:A),""))))

お礼

お礼が遅くなり、申し訳ありません。
ご教示いただいたものは、数字は統一できましたが、文字がうまくいきませんでした。
一つのセルの中に、文字と数字が混在しているセルもあるなどしてますので、入力データの内容を変えるなどして
修正して利用させていただきます。
ありがとうございました。

回答No.5

tom04

続けておじゃまします。

＞実際の行には、A列からV列までデータが入っているのです。
とありますが、Sheet1のD列まではいままでの質問通りで
計算しなくてはならないデータがE～V列まである！
という前提です。

もう一度コードを載せてみます。

Sub Sample3()
Dim i As Long, j As Long, k As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
On Error Resume Next
With wS1
i = .Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
'Sheet1のA列の「重複レコード」は無視してSheet2のA1セル以降に貼り付け
Range(.Cells(4, 1), .Cells(i, 1)).AdvancedFilter Action:=xlFilterInPlace, unique:=True
endRow = .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(5, 1), .Cells(endRow, 1)).Copy wS2.Cells(1, 1)

For i = 1 To wS2.Cells(Rows.Count, 1).End(xlUp).Row '←　Sheet2の1行目～A列最終行まで
For j = 2 To 4 '←　B～D列まで
For k = 5 To .Cells(Rows.Count, 1).End(xlUp).Row '←　Sheet1の5行目～A列最終行まで
If .Cells(k, 1) = wS2.Cells(i, 1) And .Cells(k, j) <> "" Then
Exit For
End If
Next k
wS2.Cells(i, j) = .Cells(k, j)
Next j
Next i
.AutoFilterMode = False
.ShowAllData
End With
endRow = wS2.Cells(Rows.Count, 1).End(xlUp).Row
'Sheet1のE～V列最終行までの計算
With Range(wS2.Cells(1, "E"), wS2.Cells(endRow, "V"))
.Formula = "=SUMIF(Sheet1!$A:$A,$A1,Sheet1!E:E)"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

※　前回はB～D列（データをまとめる列数）と計算する列数が同じ列数でしたが
今回はとりあえずD列までのデータを表示させ、最後に一気にE～V列の計算をしています。m(_ _)m

回答No.4

tom04

No.1・3です。

＞ShowAllData　　の部分が黄色で止まってしまいます。

というコトですので、コードに少し手を加えてみました。
具体的にココとココを！と書いても判りにくいと思いますので、
もう一度コードを載せてみます。

Sub Sample2()
Dim i As Long, j As Long, k As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
On Error Resume Next
With wS1
i = .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(4, 1), .Cells(i, 1)).AdvancedFilter Action:=xlFilterInPlace, unique:=True
endRow = .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(5, 1), .Cells(endRow, 1)).Copy wS2.Cells(1, 1)
For i = 1 To wS2.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To 4
For k = 5 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(k, 1) = wS2.Cells(i, 1) And .Cells(k, j) <> "" Then
Exit For
End If
Next k
wS2.Cells(i, j) = .Cells(k, j)
wS2.Cells(i, j + 3) = WorksheetFunction.SumIf(.Range("A:A"), wS2.Cells(i, 1), .Columns(j + 3))
Next j
Next i
.AutoFilterMode = False
.ShowAllData
End With
End Sub

今度はどうでしょうか？m(_ _)m

補足

バッチリ、思うように統一できました。
ありがとうございます。

ただ、もう一つ、ご教示お願いできますか？。
実際の行には、A列からV列までデータが入っているのです。

V例まである場合は、何処を変更すればよいのでしょうか。
申し訳ありませんが、よろしくお願いいたします。

回答No.3

tom04

No.1です！
たびたびごめんなさい。

前回は大きく外していると思います。
A列には複数のデータがあるのが普通だと思いますので、前回の方法は無視してください。

VBAになってしまいますが、一例です。
Sheet1のデータをSheet2に表示するようにしてみました。
Alt+F11キー　→　メニュー　→　挿入　→　VBE画面に↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, k As Long, endRow As Long, c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
With wS1
i = .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(4, 1), .Cells(i, 1)).AdvancedFilter Action:=xlFilterInPlace, unique:=True
endRow = .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(5, 1), .Cells(endRow, 1)).Copy wS2.Cells(1, 1)
.ShowAllData
On Error Resume Next
For i = 1 To wS2.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To 4
For k = 5 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(k, 1) = wS2.Cells(i, 1) And .Cells(k, j) <> "" Then
Exit For
End If
Next k
wS2.Cells(i, j) = .Cells(k, j)
wS2.Cells(i, j + 3) = WorksheetFunction.SumIf(.Range("A:A"), wS2.Cells(i, 1), .Columns(j + 3))
Next j
Next i
End With
End Sub 'この行まで

※　Sheet1は並び替えをしていなくても大丈夫だと思います。

こんな感じではどうでしょうか？m(_ _)m

補足

ご教示ありがとうございます。
マクロ実行では、

.ShowAllData　　の部分が黄色で止まってしまいます。

よろしくお願いします。

回答No.2

-9L9-

その程度データ数なら手作業で合計・入力するほうが効率的でしょう。
わざわざ機能を使うとしても、A列基準でソートして数値の小計を出し、BCD列はやはり手作業入力でしょう。

回答No.1

tom04

こんにちは！
A列だけに同一データがあり、他の列にはどこかの行に必ず1セルだけデータがある！
というコトですかね？
＞行は；5行目から５００行ほどあり
というコトですので、504行目までデータがあるとして・・・
一例です。

A501以降のセルに
=INDEX(A5:A504,MIN(IF(A5:A504<>"",ROW(A1:A500))))
これは配列数式になってしまいますので、Shift+Ctrl+Enterで確定！
この画面からコピー＆ペーストする場合は、
A列の表示したいセル（505行目以降）を選択　→　数式バー内で一度クリック　→　貼り付け
→　そのまま（編集可能のまま）Shift+Ctrlキーを押しながらEnterキーで確定！
数式の前後に｛　｝マークが入り配列数式になります。
これをD列までオートフィルでコピー！

※　INDEX関数の範囲指定行とROW(A1:A500)の部分の行数合わせに注意してください。

E列以降は単にSUM関数だけで大丈夫だろうと思います。m(_ _)m