いつも大変お世話になっております。
やりたいことは添付ファイルのように
書き出したいのです。
1.元データシートに
A列 日付
B列 商品
2.データ書き出し シート
A列 B列 日付
名前 商品
下記のコードは
未完成でここまでしかできませんでした。
わかる方おしえてくれませんでしょうか
Sub sample()
Dim Dic As Object, wf As Object
Dim R As Range
Dim wS As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set wS = Sheets("Sheet4") '元データシート
Set wSk = Sheets("データ書き出し")
Set wf = WorksheetFunction
For Each R In wS.Range("A2", Range("A" & Rows.Count).End(xlUp))
key = R.Offset(, 2).Value & "_" & R.Offset(, 1).Value
If Not Dic.Exists(key) Then
Dic.Add key, 0
End If
Next
sDate = wf.Min(wS.Range("A:A")) '最小日
wS.Range("C1").Value = sDate '最小日
eDate = wf.Max(wS.Range("A:A")) '最大日
'-------------------------------------------------------
Set wSk = Sheets("データ書き出し") '結果シート
wSk.Range("A1").Value = "名前"
wSk.Range("B1").Value = "商品"
wSk.Range("c1").AutoFill Destination:= _
wSk.Range("c1").Resize(1, eDate - sDate + 1), _
Type:=xlFillDefault 'C1から右に最小日から最大日まで
wSk.Range("1:1").NumberFormat = "m/d" '日付の書式
Set rr = wSk.Range("A2")
For Each key In Dic.keys
rr.Resize(, 2) = Split(key, "_")
rr.Offset(, 3).Resize(, 100) = Dic(key)
Next
End Sub
No.5ベストアンサー
- 回答日時:
予め、元シートのデータ範囲の表を見出しまで含めて、テーブルにしておくものとします。
テーブルーが作成されるとExcelは、自動的に「テーブル1」「テーブル2」などの名称を設定してくれます。同時に、作成したテーブルに名前が定義されます。「数式」タブ⇒「名前の管理」⇒「名前の管理」ダイアログボックスで確認できます。
とりあえず、この方法で確認したら「テーブル1」という名前だったとします。
以下のコードはご質問者のご要望を拡大解釈して、「ピボットテーブルでよいのでは」と考え、ピボットテーブルを作成するサンプルです。
参考になれば幸いです。
Sub sample_12704206()
Dim pvf As PivotField
ActiveWorkbook.PivotCaches.Create(xlDatabase, _
"テーブル1").CreatePivotTable Sheets.Add.Range("A3")
With ActiveSheet.PivotTables(1)
.PivotFields("名前").Orientation = xlRowField
.PivotFields("商品").Orientation = xlRowField
.PivotFields("日付").Orientation = xlColumnField
.PivotFields("商品").Orientation = xlDataField
.RowAxisLayout xlTabularRow
On Error Resume Next
For Each pvf In .PivotFields
pvf.Subtotals(1) = True
pvf.Subtotals(1) = False
Next pvf
On Error GoTo 0
.RepeatAllLabels xlDoNotRepeatLabels
.ColumnGrand = False
.RowGrand = False
End With
With ActiveSheet
.Range("C4").Select
.Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormatLocal = "m/d;@"
.Range("A3").Select
End With
End Sub
No.4
- 回答日時:
漏れてました。
>>あと同じ人が同じ日に同じ商品を別の行で表示されている(左側)って可能性はあるのでしょうか?
>ないです。
同じ人が『違う日』に同じ商品をって事はありますか?
この内容によっては個人的に .NETFramework3.5 を呼び出したい所ですが、最新のWin10などは無理っぽいですから代替えが必要かなと。
と、スマホではこの位になってしまいます。
No.2
- 回答日時:
No.1です。
>>それと右側のA列・B列はその出力であってますか?
>あってないです。
ではどの様に?
B2から商品名を並べ一番最後の商品名のある次の行を1つ空けて、A列に名前・B列に商品名を並べるのかな?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) エラーコード1004 6 2022/06/09 14:12
- Excel(エクセル) vba シート名の一覧を2列に分けるには 5 2023/04/24 08:56
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Excel(エクセル) エクセル 値をコピペした時に、条件付き書式で塗られた背景色もペーストさせる 2 2023/04/05 17:21
- Excel(エクセル) マクロで行を追加、削除すると行位置がずれますが、解決方法はありませんか?。 5 2022/05/28 16:03
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
【VBA】2つのシートの値を比較...
-
Cellsのかっこの中はどっちが行...
-
vbaでシートより100より大きい...
-
データグリッドビューの一番最...
-
VBA 何かしら文字が入っていたら
-
VBAを使って検索したセルをコピ...
-
rowsとcolsの意味
-
vba 2つの条件が一致したら...
-
マクロで列を加えたら上手くい...
-
マクロ 最終列をコピーして最終...
-
VBA とびとびの列を結合させる
-
VBAで10行おきにセルの下に罫線...
-
エクセル VBA ユーザーフォー...
-
文字列の結合を空白行まで実行
-
複数処理 Worksheet_Change(ByV...
-
Changeイベントでの複数セルの...
-
エクセル 2つの表の並べ替え
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
B列の最終行までA列をオート...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
文字列の結合を空白行まで実行
-
VBA指定行削除
-
VBAのFind関数で結合セルを検索...
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
マクロ 最終列をコピーして最終...
-
エクセルについて
-
【VBA】2つのシートの値を比較...
-
URLのリンク切れをマクロを使っ...
-
データグリッドビューの一番最...
-
Changeイベントでの複数セルの...
-
空白セルをとばして転記
-
rowsとcolsの意味
-
エクセルVBAにて =A1=B1とすれ...
おすすめ情報
画像の右側ってミスっている状態ですよね?
はい
あと同じ人が同じ日に同じ商品を別の行で表示されている(左側)って可能性はあるのでしょうか?
ないです。
それと右側のA列・B列はその出力であってますか?
あってないです。
⇒何となくですが昨年位に回答した物に似ているような???
すみません わたしなりに解決できないかった。
本当のところは
下記のコードを短くしたいのです。
何回かに分けます。
Sub sample()
Dim Dic As Object
Dim wS As Worksheet
Dim lastRow As Long
Dim R As Long
Dim dt As Variant 'Date
Dim pr As Variant 'String
Dim nm As Variant 'String
Dim sDate As Date
Dim eDate As Date
Dim rng As Range
'
Set Dic = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクト
Set wS = Sheets("Jag04") '元データシート
lastRow = wS.Range("A" & Rows.Count).End(xlUp).Row
For R = 2 To lastRow
dt = wS.Range("A" & R).Value '日付
pr = wS.Range("B" & R).Value '商品
nm = wS.Range("C" & R).Value '名前
If Not Dic.Exists(nm) Then
Dic.Add nm, CreateObject("Scripting.Dictionary")
End If
If Not Dic(nm).Exists(pr) Then
Dic(nm).Add pr, CreateObject("Scripting.Dictionary")
End If
If Not Dic(nm)(pr).Exists(dt) Then
Dic(nm)(pr).Add dt, 0
End If
Dic(nm)(pr)(dt) = Dic(nm)(pr)(dt) + 1
Next
sDate = WorksheetFunction.Min(wS.Range("A:A")) '最小日
eDate = WorksheetFunction.Max(wS.Range("A:A")) '最大日
Set wS = Sheets("Jag04抽出") '結果シート
'ws.Cells.ClearContents
wS.Range("A1").Value = "名前"
wS.Range("B1").Value = "商品"
wS.Range("C1").Value = sDate '最小日
wS.Range("c1").AutoFill Destination:=wS.Range("c1").Resize(1, eDate - sDate + 1), Type:=xlFillDefault 'C1から右に最小日から最大日まで
wS.Range("1:1").NumberFormat = "m/d" '日付の書式
R = 2 '結果表示行(初期値=2)
For Each nm In Dic.keys 'dictionaryのキー(名前)を順に
wS.Range("A" & R).Value = nm 'A列に名前
R = R + 1 '表示行+1
For Each pr In Dic(nm).keys '名前がキーのdictionaryのキー(商品)を順に
wS.Range("B" & R).Value = pr 'B列に商品
R = R + 1 '表示行+1
For Each dt In Dic(nm)(pr).keys '名前がキーのdictionaryの中の商品がキーのdictionaryの中のキー(日付)を順に
Set rng = wS.Range("1:1").Find(Format(dt, "m/d"), LookIn:=xlValues, lookat:=xlWhole) '1行目で日付を検索
wS.Cells(R, rng.Column).Value = Dic(nm)(pr)(dt) '注目行と日付の交差するセルに名前、商品、日付がキーのdictionaryの値(個数)を表示
Next
Next
R = R + 1 '表示行+1
Next
End Sub
これが全てです。 どこか短くできるところあればおしえてくれませんでしょうか
A列・B列はその出力とは
下記のように書き出したいです。
ただ
あっているかはわかりません。
名前 商品
Aさん
バナナ
みかん
ぶどう
キウイ
りんご
もも
メロン
なし
レモン
すみません
ずれていました。
焦っています。
A列・B列はその出力とは
下記のように書き出したいです。
ただ
あっているかはわかりません。
A列 B列
名前 商品
Aさん バナナ
みかん
ぶどう
リンゴ
キウイ
リンゴ
もも
メロン
なし
レモン
日付の転記については画像から
・日付は昇順に並んでいる。
並んでいます。
・重複は存在しない。
存在しません
・日にちが飛んでる箇所もない。
日にち飛んでいる箇所あります。
例えば同じ人が同日に複数の商品をとかね
ある可能性もあります。
すみせんです。
お忙しいところ