![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
No.11ベストアンサー
- 回答日時:
No.9です。
他の方の回答(疑問)をみて。
仮に1個当たりの内容を知りたいってだけであれば、
If Not myDic.Exists(st) Then _
myDic.Add st, Array(r.Text, r.Offset(, 1).Value, 0, _
r.Range("C1").Offset(, i).Value, r.Range("C1").Offset(, i + n).Value)
v = myDic(st)
v(2) = v(2) + 1
myDic(st) = v
ここの部分を
If Not myDic.Exists(st) Then _
myDic.Add st, Array(r.Text, r.Offset(, 1).Value, 1, _
r.Range("C1").Offset(, i).Value, r.Range("C1").Offset(, i + n).Value)
'v = myDic(st) 削除
'v(2) = v(2) + 1 削除
'myDic(st) = v 削除
If文だけ一部修正してあとは削除で。
Dictionary でできるんですね。
私のVBAの知識が足りませんでした。
すらすらと出来たのでとっても感謝です。
ありがとうございました。
No.12
- 回答日時:
No.9 のコードについて
転記先の以前のデータを削除で
.Cells.ClearComments '以前のデータを削除します
としましたが、急いでいて1つずれた所を選択してしまいました。
実際には
.Cells.ClearContents '以前のデータを削除します
こちらです。
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_14.png?5a7ff87)
No.10
- 回答日時:
No7です。
念のため確認ですが、元のデータが
10:00 りんご 3 大 大 大 100 100 100
の場合、
並べ替えた結果は
①
10:00 りんご 1 大 100
10:00 りんご 1 大 100
10:00 りんご 1 大 100
ですよね。その前提で作成しています。
②
10:00 りんご 3 大 100
にはなりません。
もし、②にようにしたいということであれば、その旨補足ください。
又、②の場合は、品名、種類、価格が同じなら、同じものという前提でよいのですか。
品名、種類、価格が同じでも、ちがうものがあることはないのでしょうか。
例えば、並べ替えた結果を
③
10:00 りんご 1 大 100・・・・・A
10:00 りんご 2 大 100・・・・・B
のようにしたいということはありますか。
その場合は、どのようにAとBを区別するかその基準がないので、できません。
もし、区別する基準を提示していただければできるかも知れません。
No.9
- 回答日時:
最初変に考えすぎてしまいましたが、ちょっと前に回答した質問とそんなに変わらなかったですね。
Dictionaryいけましたよ。
Sub test()
Dim myDic As Object
Dim r As Range
Dim i As Integer, n As Integer
Dim st As String
Dim v
Set myDic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1") 'Sheet名は適宜修正願います
For Each r In .Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp))
n = r.Range("C1").Value
For i = 1 To n
st = Join(Array(r.Text, r.Offset(, 1).Value, r.Range("C1").Offset(, i).Value, _
r.Range("C1").Offset(, i + n).Value), "_")
If Not myDic.Exists(st) Then _
myDic.Add st, Array(r.Text, r.Offset(, 1).Value, 0, _
r.Range("C1").Offset(, i).Value, r.Range("C1").Offset(, i + n).Value)
v = myDic(st)
v(2) = v(2) + 1
myDic(st) = v
Next
Next
End With
With Worksheets("Sheet2") 'Sheet名は適宜修正願います
.Cells.ClearComments '以前のデータを削除します
.Range("A1:E1").Value = Array("時間", "品名", "個数", "種類", "価格")
.Range("A2").Resize(myDic.Count, 5).Value = _
Application.Transpose(Application.Transpose(myDic.Items))
End With
Set myDic = Nothing
End Sub
あとはコピーを取ったブックでテストしてみて下さい。
Sheet名には気をつけて。
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_14.png?5a7ff87)
No.7
- 回答日時:
No5です。
以下のマクロを標準モジュールに登録してください。
元のシートのシート名は、"Sheet1"
並べ替え後のシートのシート名は、"Sheet2"にしてあります。
もしシート名が異なるなら
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
の箇所をあなたの環境のシート名に合わせてください。
並べ替え後のシートのセルの日付等の書式設定はあなたが適切に行ってください。(一度行えば、ずっとそれが保持されます)
並べ替え後のシートの1行目の見出し行は、あなたが作成しておいてください。
------------------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim i As Long
Dim kosu As Long
Dim cola As Long
Dim colb As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row '最大行取得
maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row '最大行取得
If maxrow2 > 1 Then
sh2.Range("A2:" & "E" & maxrow2).Value = ""
End If
row2 = 2
'2行~最終行まで繰り返す
For row1 = 2 To maxrow1
kosu = sh1.Cells(row1, "C").Value
'個数分繰り返す
For i = 1 To kosu
sh2.Cells(row2, "A").Value = sh1.Cells(row1, "A").Value '時間
sh2.Cells(row2, "B").Value = sh1.Cells(row1, "B").Value '品名
sh2.Cells(row2, "C").Value = 1 '個数
cola = 3 + i
sh2.Cells(row2, "D").Value = sh1.Cells(row1, cola).Value '種類
colb = 3 + kosu + i
sh2.Cells(row2, "E").Value = sh1.Cells(row1, colb).Value '価格
row2 = row2 + 1
Next
Next
MsgBox ("完了")
End Sub
ありがとうございます。 For Next の構文だけで出来るんですね。
参考になりした。
とても良かったのですが、実際のデータ数がかなりあり、試したのですが
かなり時間が掛かってしまいました。
No.4
- 回答日時:
No.2のお礼に対して。
>種類の数は大中小だけでなく、様々な種類、があります。
お聞きしたかったのは、それぞれの【種類】に対して【個数】をカウントする必要の有無と、
【種類】が同じでも【価格】が違う場合があるのかどうかですね。
別回答で二重ループの話が出てますが、それにつきましては賛同しますけど、
No.1の回答に書いたように【梨 大】が80と40になっているのか?
質問の写真や補足からは【梨 大】は80しかなく、【個数】は【2】になるはずなのにと言う点です。
考え方としてはNo.3さんと似た感じになりそうですが、C列の使い方とカウントの取り方が違う位ですかね。
でも【種類】が多いってなると私には大変かな?(VB.NETなら機能が色々あって楽なんですけど)
お付き合い頂きありがとうございます。
仰るとおり、種類に対して個数をカウントする必要があります。
種類が同じでも価格が違う場合があり、一つ一つの価格を把握する為、
例えば3個売れた【梨】が一つ一つの価格を横に列記したいと考えております。
No.3
- 回答日時:
二重ループでやればできます。
1.行ごとのループ(loop変数をnLineとします)
2.各行の商品のループ(ループ変数をnCellとします)
ループ回数は、C列の数を使います。(nCntにセットしたとします)
shtResult.cells(nWrtLine,1)=shtData.cells(nLine,1).Value
shtResult.cells(nWrtLine,2)=shtData.cells(nLine,2).Value
shtResult.cells(nWrtLine,3)=shtData.cells(nLine,3+nCell).Value
shtResult.cells(nWrtLine,4)=shtData.cells(nLine,3+nCnt+nCell).Value
nWrtLine = nWrtLine+1
そして
回答ありがとうございます。
凄く大きなヒントをもらったような。。。!
やってるんですができませんね。。
もう少し、VBAを勉強します。
ありがとうございます!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルでのマクロを使ったデータの並べ替え 3 2022/12/03 18:54
- Visual Basic(VBA) 【VBA】もし、値が0だったら左のセルと合わせて削除したい 3 2023/04/20 10:12
- Visual Basic(VBA) VBA横データを縦にしたいです 2 2023/08/08 19:38
- Visual Basic(VBA) Excelで横書き50行の漢字テストデータを縦書きのテスト問題にしたい。 6 2022/04/27 15:03
- Excel(エクセル) エクセルで対象日に該当するデータがある場合に別表へ全対象者を表示させたい。 3 2023/07/12 09:48
- Visual Basic(VBA) VBA横に並んでいるデータを縦に並ぶデータにしたいです。 4 2023/08/09 08:53
- Visual Basic(VBA) エクセル 2つの列にある値の完全一致を抜き出すVBA 15 2022/12/15 03:22
- Excel(エクセル) Excel 表の作成について 3 2022/06/16 12:15
- Excel(エクセル) VBAでユークリッド距離を用いて1番近い物を表示 表 裏 縦 横 高さ 縦 横 高さ 名前 1 45 9 2022/10/23 16:52
- その他(Microsoft Office) 1の行を固定した上でVBAを用いて日付順に自動並べ替え 2 2022/06/06 15:09
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
Count Ifのセルの範囲指定に変...
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
Unionでの他のシートの参照につ...
-
VBA 空白行に転記する
-
Changeイベントで複数セルへの...
-
前回質問の続きになりますが、...
-
【VBA】特定の条件でセルをコピー
-
【Excel VBA】自動メール送信の...
-
複数シートの複数列に入力され...
-
テキストボックスから、複数の...
-
FindNextがうまくいかない
-
VBA 別ブックからの転記の高速...
-
VBAで変数の数/変数名を動的に...
-
VBAのグラフに違うシートの...
-
VBA 実行時エラー1004 rangeメ...
-
VBA別シートの最終行の次行へ転...
-
VBAで、1つのエクセルで、2つの...
-
Excel2013で切り取り禁止
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
Count Ifのセルの範囲指定に変...
-
VBA 別ブックからの転記の高速...
-
VBA別シートの最終行の次行へ転...
-
Changeイベントで複数セルへの...
-
複数シートの複数列に入力され...
-
ExcelのVBマクロを、バックグラ...
-
VBA 実行時エラー1004 rangeメ...
-
楽天RSSからエクセルVBAを使用...
-
【VBA】特定の条件でセルをコピー
-
100万件越えCSVから条件を満た...
-
Excel2013で切り取り禁止
-
VBAで変数の数/変数名を動的に...
-
アクセスからエクセルへ出力時...
-
Unionでの他のシートの参照につ...
-
グラフマクロで系列を変数にす...
-
Excel VBA オートフィルターで...
おすすめ情報
画像が小さいので拡大すると
時間 品名 個数 種類 価格
10:00 りんご 3 大 中 小 100 50 20
10:10 梨 5 大 中 中 大 小 80 40 40 80 10
10:15 イチゴ 4 大 大 小 中 150 150 70 100
10:30 りんご 2 大 小 100 20
<マクロ実施後>
時間 品名 個数 種類 価格
10:00 りんご 1 大 100
10:00 りんご 1 中 50
10:00 りんご 1 小 20
10:10 梨 1 大 80
10:10 梨 1 中 40
10:10 梨 1 大 40
としたいのです。