前回とほぼ同じ質問なのですが、宜しくお願いします。
複数のセルに書かれている日付を
1つのセルにまとめて表示させたいと考えています。
日付は、
10/3,トマト,長野(,で別セルとします)
4/5,トマト,長野
5/7,トマト,神奈川
5/6,レタス,千葉
3/4,レタス,東京
1/3,レタス,東京
のように縦に並んでいまして、
下の行(1/3)から1つのセルに入れていき
3/4,レタス,東京,1/3・3/4と
[1/3・3/4]を1つのセルに入れ、
しかも出来れば「・」を間に入れて
1つのセルに表示させたいのです。
そして、同様にトマトにおいても行い、
最終的には、
10/3,トマト,長野,4/5・10/3
4/5,トマト,長野
5/7,トマト,神奈川,5/7
5/6,レタス,千葉,5/6
3/4,レタス,東京,1/3・3/4
1/3,レタス,東京
と表示させたいと思っております。
一致材料は2つあり、
品物と産地が一致することが必要です。
このとき、レタスとトマトの個数は数えなければ
わかりません。
ここで教えていただいたことを、実際には
6個の項目が一致して始めて日付を1セルに
まとめたいと思っています。しかも間には
判断とは関係ない列も含まれ、6項目が
横に連続はしていません。
配列を使えば良いみたいですが、勉強不足です。
大変難しいかと思いますが、
ぜひお知恵を貸して頂ければ幸いです
No.1ベストアンサー
- 回答日時:
参考URLの
Public Sub dateCat()~End Subの部分を以下の部分で置き換えてください。
実行方法は、参考URLと同じです。
月日が1つだけの場合は自動的に書式が変わってしまうかもしれませんが、その場合は手動で書式を設定してやってください。
'---------8<------------8<-------------
Public Sub dateCatM() '先頭の日付のセルをアクティブセルで呼び出し
Dim name, list
Dim a(), i, x
Dim r As Range, top As Range, bottom As Range
Do While ActiveCell.Value <> ""
Set top = ActiveCell
name = ActiveCell.Offset(0, 1).Value & ActiveCell.Offset(0, 2).Value '比較部分を取り出す
i = 0
Do While name = top.Offset(i, 1).Value & top.Offset(i, 2).Value
i = i + 1 '名前が同じ間
Loop
Set bottom = top.Offset(i - 1, 0)
Set r = Range(top, bottom)
ReDim a(r.count)
i = 0
For Each x In r
a(i) = x.Value
i = i + 1
Next
Call ArraySort(a, True)
list = ""
For Each x In a
list = list & Format(x, "m/d・")
Next
list = Left(list, Len(list) - 1) '最後の・を取る
ActiveCell.Offset(0, 3).Value = list '最初の行にリストを入力
bottom.Offset(1, 0).Activate 'アクティブセルの設定
Loop
End Sub
'---------8<------------8<-------------
>実際には6個の項目が一致して
参考URLと今回のソースを見比べてもらえばわかりますが、変更したのは3カ所だけです。
>name = ActiveCell.Offset(0, 1).Value & ActiveCell.Offset(0, 2).Value '比較部分を取り出す
>Do While name = top.Offset(i, 1).Value & top.Offset(i, 2).Value
>ActiveCell.Offset(0, 3).Value = list '最初の行にリストを入力
nameに関する処は、条件が増えるたびに
& ActiveCell.Offset(0, 2).Value
を追加していけばよいです。数字の2の部分を列数に合わせて増やします。アクティブセルの位置が0として数えます。
最後に日付をセットしている行も3の部分を位置に合わせて変更します。
参考URL:http://okweb.jp/kotaeru.php3?qid=1289626
No.2
- 回答日時:
おはようございます。
配列はちょと難しいということなので配列なしを。(^^;;;
●見出しが1行目、データは2行目から
--------------------------------------------------
A B C D E F
1 日付 項目2 種類 項目4 産地 項目6
--------------------------------------------------
●結果は、同じシートで以下の列に2行目から
--------------------------------------------------
K L M N
1 日付 種類 産地 全日付
--------------------------------------------------
Sub Test()
Dim R As Long
Dim Krow As Long '結果書込み行
Dim KekkaRow As Long '全日付結果を書き込む行
Dim Kekka '全日付結果溜め込み用
Dim Syurui '種類比較用
Dim Sanchi '産地比較用
'種類、産地、日付でソート(マクロ記録で取る)
Range("A1").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("E2") _
, Order2:=xlDescending, Key3:=Range("A2"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, SortMethod:=xlPinYin
'処理スタート
Krow = 2
KekkaRow = Krow
Cells(Krow, "K") = Cells(2, "A")
Cells(Krow, "L") = Cells(2, "C")
Cells(Krow, "M") = Cells(2, "E")
Kekka = Format(Cells(2, "A"), "mm/dd")
Syurui = Cells(2, "C")
Sanchi = Cells(2, "E")
For R = 3 To Range("A65536").End(xlUp).Row
If Syurui = Cells(R, "C") And Sanchi = Cells(R, "E") Then
Krow = Krow + 1
Cells(Krow, "K") = Cells(R, "A")
Cells(Krow, "L") = Cells(R, "C")
Cells(Krow, "M") = Cells(R, "E")
Kekka = Format(Cells(R, "A"), "mm/dd") & "・" & Kekka
Else
Cells(KekkaRow, "N") = Kekka
Krow = Krow + 1
KekkaRow = Krow
Cells(Krow, "K") = Cells(R, "A")
Cells(Krow, "L") = Cells(R, "C")
Cells(Krow, "M") = Cells(R, "E")
Kekka = Format(Cells(R, "A"), "mm/dd")
Syurui = Cells(R, "C")
Sanchi = Cells(R, "E")
End If
Next R
Cells(KekkaRow, "N") = Kekka
Columns("K:K").NumberFormatLocal = "mm/dd"
Columns("K:N").AutoFit
End Sub
-------------------------------------------------
処理の流れが分かるように似たようなコードもサブルーチンにしてありません。
また、画面の状況が目で確かめらるようにScreenUpdatingは入れてありません。
この際ですから配列もしっかり勉強しませう。(^^;;;
以上です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) WORKDAY関数 4 2023/06/08 13:23
- 食べ物・食材 キャベツとレタス・白菜 8 2023/01/13 18:00
- ダイエット・食事制限 サラダダイエット成功した方 朝 普通に食べる 昼・夜 サラダ(内容:レタス、トマト、アボカド、鶏むね 1 2023/03/01 22:55
- Excel(エクセル) エクセル関数について 2 2022/04/13 18:25
- Visual Basic(VBA) エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい 9 2022/08/24 13:23
- Excel(エクセル) エクセルの祝日に色が反映しない 4 2022/05/18 09:58
- Excel(エクセル) 指定値をマクロで検索&シート移動 2 2022/04/27 23:29
- Excel(エクセル) ユーザー定義について質問です。 2 2023/06/28 13:21
- Excel(エクセル) Excelで数式をそのままコピーしたい どうすればいいですか? 4 2022/09/16 02:16
- Excel(エクセル) Excelで一つのセルを2行で表示 4 2022/07/01 22:07
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
賞味期限から5日経ったミンチ肉...
-
サラダって前の日に作ったやつ...
-
不味~い(冷凍)ハンバーグを...
-
3〜5ヶ月前に冷凍したハンバー...
-
弁当にタマゴサラダやポテトサ...
-
生焼けのハンバーグについて
-
ハンバーグを生焼けで食べてし...
-
消費期限切れ(1日目)食べれ...
-
ハンバーグを根気よく焼いても...
-
2人晩御飯のみで食費2万円は...
-
お昼間に作りおきして夕飯に出...
-
チキンフィレオとチキンタツタ...
-
こんにちは!今日は久しぶりに...
-
女性はみんな、茄子が好き??
-
失敗したポテトサラダのアレンジ
-
奈良県で有名な食べ物はなんで...
-
ちょいと大喜利 画像見てボケて...
-
生野菜サラダの具材
-
常温放置してしまったサラダに...
-
食事の品数
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
不味~い(冷凍)ハンバーグを...
-
賞味期限から5日経ったミンチ肉...
-
サラダって前の日に作ったやつ...
-
レタス巻きとサラダ巻きの違い
-
3〜5ヶ月前に冷凍したハンバー...
-
サニーレタスっていくら洗って...
-
こんにちは!今日は久しぶりに...
-
消費期限切れ(1日目)食べれ...
-
2人晩御飯のみで食費2万円は...
-
最高のサラダはポテトサラダと...
-
失敗したポテトサラダのアレンジ
-
ハンバーグを根気よく焼いても...
-
缶詰や紙パック入り豆の水煮の...
-
ハンバーグを生焼けで食べてし...
-
ひき肉料理で肉を固くしない方...
-
お昼間に作りおきして夕飯に出...
-
ハンバーグ嫌いな人いますか? ...
-
ハンバーグの牛骨は異物か否か
-
失敗した茶碗蒸しの使い道を考...
-
カニに合う料理
おすすめ情報