【先着1,000名様!】1,000円分をプレゼント!

VBAについて質問です。
時系列に並んだ横一列のデータを縦に時系列と種別に分けて
縦に整理したいのですがどなたか、VBAで処理する方法を
ご存知でしょうか?
言葉で説明できないので画像を添付しました。
よろしくお願いします。

「エクセル 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

    としたいのです。

      補足日時:2017/11/02 04:43

A 回答 (12件中1~10件)

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文だけ一部修正してあとは削除で。
    • good
    • 0
この回答へのお礼

Dictionary でできるんですね。
私のVBAの知識が足りませんでした。
すらすらと出来たのでとっても感謝です。
ありがとうございました。

お礼日時:2017/11/02 19:24

No.9 のコードについて



転記先の以前のデータを削除で

.Cells.ClearComments '以前のデータを削除します

としましたが、急いでいて1つずれた所を選択してしまいました。
実際には

.Cells.ClearContents '以前のデータを削除します

こちらです。
    • good
    • 0

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を区別するかその基準がないので、できません。
もし、区別する基準を提示していただければできるかも知れません。
    • good
    • 0

最初変に考えすぎてしまいましたが、ちょっと前に回答した質問とそんなに変わらなかったですね。


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名には気をつけて。
    • good
    • 1

No.6のお礼に対して



>Dictionary Objectは使えませんでした。

いえ、使えますよ。

ただ回答が付いたようなので、私の回答必要ないかな?
    • good
    • 0

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
    • good
    • 1
この回答へのお礼

ありがとうございます。 For Next の構文だけで出来るんですね。
参考になりした。
とても良かったのですが、実際のデータ数がかなりあり、試したのですが
かなり時間が掛かってしまいました。

お礼日時:2017/11/02 19:22

No.4です。



すなわち【時間-品名-種類-価格】の組み合わせで【個数】のカウントが取れれば宜しいのですよね?
ならDictionaryオブジェクト1個使ってやればいけそうですが、検証には時間かかるかも知れませんので、
他に回答が付いたら締め切って頂いても構いません。
    • good
    • 0
この回答へのお礼

色々ありがとうございます。
残念ながら、品名、種類が同じでも価格が全て違うので、
一つ一つを時系列に列挙する必要があり、Dictionary Objectは
使えませんでした。

お礼日時:2017/11/02 09:00

念の為、確認ですが


1)元のシートの個数がn個の場合、その次の列に、n個の種類が並び、更にそのあとに、n個の価格が並ぶ。
2)並び替え後のシートの個数は、常に1個である。(個数が2個又は3個等になることはない)
という前提で良いでしょうか。
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
1)その前提で考えて頂いて結構です。
2)常に1個に対する種類と価格があります。
よろしくお願いします。

お礼日時:2017/11/02 08:13

No.2のお礼に対して。



>種類の数は大中小だけでなく、様々な種類、があります。

お聞きしたかったのは、それぞれの【種類】に対して【個数】をカウントする必要の有無と、
【種類】が同じでも【価格】が違う場合があるのかどうかですね。

別回答で二重ループの話が出てますが、それにつきましては賛同しますけど、
No.1の回答に書いたように【梨 大】が80と40になっているのか?
質問の写真や補足からは【梨 大】は80しかなく、【個数】は【2】になるはずなのにと言う点です。

考え方としてはNo.3さんと似た感じになりそうですが、C列の使い方とカウントの取り方が違う位ですかね。
でも【種類】が多いってなると私には大変かな?(VB.NETなら機能が色々あって楽なんですけど)
    • good
    • 1
この回答へのお礼

お付き合い頂きありがとうございます。
仰るとおり、種類に対して個数をカウントする必要があります。
種類が同じでも価格が違う場合があり、一つ一つの価格を把握する為、
例えば3個売れた【梨】が一つ一つの価格を横に列記したいと考えております。

お礼日時:2017/11/02 08:10

二重ループでやればできます。


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




そして
    • good
    • 1
この回答へのお礼

回答ありがとうございます。
凄く大きなヒントをもらったような。。。!
やってるんですができませんね。。
もう少し、VBAを勉強します。
ありがとうございます!

お礼日時:2017/11/02 07:51

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

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

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

Qエクセルで横並びの複数データを縦の一本のデータにしたい

こんにちは。宜しくお願い致します。

   A   B  C
1 静岡 埼玉 
2 福島 東京 愛媛
3 青森 
4 長崎 徳島 愛媛
5 東京 千葉 
6 秋田 兵庫 大阪
.
.
.


例えばこういう形で好きな都道府県の上位3つの解答がそれぞれあったとします。(1個の人もいるし、2個の人もいます)

これを別のシート(同じシートの違う場所でも構いません)に縦並び1本で出したいときどうしたらいいでしょうか。

★こういう風にしたい★

静岡
福島
青森
長崎
東京
秋田
埼玉
東京
愛媛
徳島
愛媛
千葉
兵庫
大阪
.
.

※好きな県などが人によって重複していても構いません、また順不同でもいいです。(縦並びのデータに東京が20個あってもよいということ)

形式を選択して貼り付けで行列を入れ替えるではうまくいかないです。

宜しくお願い致します。

Aベストアンサー

VBAで、もっと簡単に。
下記をVBEの標準モジュールにコピーし貼りつけ。
元データのあるシートで、データのある範囲を範囲指定して(空白セルが範囲内にあっても結構)、下記を実行。
Sub ichiretu()
Dim cl As Range
p = 1
For Each cl In Selection
If cl <> "" Then
Worksheets("sheet3").Cells(p, "A") = cl
p = p + 1
End If
Next
End Sub
Sheet3のA列に並びます。

Qエクセルで縦に並んだデータを横に並び替えたい

エクセルで↓ のようなデータがあります

 | A | B | C | D
1|A店|りんご| 2 |
2|A店|みかん| 3 |
3|A店|バナナ| 4 |
4|B店|りんご| 3 |
5|B店|バナナ| 2 |

これを以下のようなかたちにしたいのですが、一つずつ移動する以外に方法はありますか?

 | A | B | C | D | E | F | G |
1|A店|りんご| 2 |みかん| 3 |バナナ| 4 |
2|B店|りんご| 3 |バナナ| 2 |


100以上データがあり、手作業で移すのは大変です。
ちなみにVBAなどはほとんど理解できません。

何か解決策があればと質問させていただきたました。
よろしくお願いします。

Aベストアンサー

E列に店名リストを作成する
(なければフィルタオプションの設定で重複するレコードを無視するを使うとよい)

F1セルに 1 右へ連番
N2セルに =COUNTIF(A:A,E2) 下へオートフィル
F2セルに
=IF(F$1>$N2*2,"",INDEX($B:$C,MATCH($E2,$A:$A,0)+F$1/2,1))
G2セルに
=IF(F$1>$N2*2,"",INDEX($B:$C,MATCH($E2,$A:$A,0)+G$1/2-1,2))
F2:G2セルを選択して、右へオートフィル、そのまま下へオートフィル

E:N列を選択して 切り取り 別シートへ貼り付け

Qエクセルで1列に500行並んだデータを5列毎に改行

エクセル2000で、A1~A500までデータが縦並びに入力されています。

これを5列毎に改行して、横並びのデータに加工したいのですが、何か方法ありますか?

図解すると、、


A1
A2
A3
A4
A5
A6
A7


A500

のデータを

A1 A2 A3 A4 A5
A6 A7 A8 A9 A10
・・・・・・
A496 A497 A498 A499 A500



したいのです。

何かよい方法ありましたらお教え願います。

Aベストアンサー

'直接シートをいじるのでコピーをしてから試してみてください。
Sub Macro1()
COUNTER = 0
For INP = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 5
COUNTER = COUNTER + 1
Range("A" & INP & ":A" & INP + 4).Copy
Range("B" & COUNTER).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next INP
Range("A1").EntireColumn.Delete
End Sub

Qエクセル 同じ値を探して隣の数値をコピーする

エクセルで以下の作業を簡単にする方法を教えて下さい。

Sheet1の1行目には見出しがあり、A列とB列の2行目から下にデータが入っています。(約200行)
A列     B列
田中    13
山本     8
谷口    11
鈴木    6
佐々木    9
奥村     15




Sheet2のA列1行目から下には別のデータが入っています。(約600行)
A列
太田川
山村
田中
多賀先
鈴木
奥村
幸田




Sheet2のA列のデータと完全一致するデータ(名前)をSheet1のA列から探して、同じ名前があれば、その隣のB列にある数値をSheet2のB列に貼り付ける。
見つからない場合はSheet2のB列は空欄のままです。
Sheet2
A列      B列
太田川     
山村
田中    13
多賀先
鈴木     6
奥村    15
幸田


Aベストアンサー

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

=IF(COUNTIF(Sheet1!A:A,A2)=0,"",VLOOKUP(A2,Sheet1!A:B,2,FALSE))

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

Qエクセルで横データを縦に並べ変えたいです。

すみません。誰か教えて下さい。

下記の様な並べ替えが出来る関数を誰か知りませんか?

マンションA 101 107 201
マンションB 202 405
マンションC 102 203 301 501
マンションD 103 201 405



マンションA101
マンションA 107
マンションA 201
マンションB202
マンションB 405
マンションC102
マンションC 203
マンションC 301
マンションC 501
マンションD103
マンションD 201
マンションD 405

誰かご存知の方いましたら教えて下さい。

Aベストアンサー

参考です。
可変データの取り扱いはマクロ(VBA)が簡単です。
データをSheet1、並び替えをSheet2に行います。
(1)Sheet1タブ上で右クリック→コードの表示→以下のサンプルコードを貼り付け→F5キー押下
   マクロの削除は貼り付けたコードを全削除して下さい。

サンプルです。
Sub 並び替え()
Set st1 = Sheets("sheet1")
Set st2 = Sheets("sheet2")
For i = 1 To st1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To st1.Cells(i, Columns.Count).End(xlToLeft).Column
n = n + 1
st2.Cells(n, 1) = st1.Cells(i, 1)
st2.Cells(n, 2) = st1.Cells(i, j)
Next
Next
End Sub

Qエクセルである行以下全部を削除する方法

エクセルである行(もしくは列)以下を全部 削除したいのですが、簡単な方法があれば教えてください。選択して削除するにはあまりにも長く、スクロールしているうちに別のところを指定してしまったりして困っております、
MS office 97 を使用しています、

Aベストアンサー

こんにちは

> 列や行を削除しても空白の行がまた、入ってしまうのはどうやればよいのでしょうか?

 列や行を非表示にするのは、いかがでしょうか?
 例えば、11行目以降を非表示にするには以下の手順です。

1.11行目のセルのどれかを選択
2.Ctrl+Shift+↓
3.メニュー[書式]-[行]-[表示しない]

 11行目以降を再び表示させるには、

1.Ctrl+A(または全セル選択ボタンをクリック)
2.メニュー[書式]-[行]-[再表示]

参考URL:http://www2.odn.ne.jp/excel/

Qエクセルで特定の行を削除したいのですが。

エクセルで特定の行を一発で削除したいのですが、やり方がわかりません。
どなたか詳しい方お教えいただけませんでしょうか?

やりたいことは、B列に、特定の文字が有れば、その行全部を削除して上方向にシフトしていきたいのですが、マクロとかを使うのでしょうか?
宜しくお願いいたします。

Aベストアンサー

マクロを使う別の方法です。
XXXの部分を特定の文字に置きかえて実行してください。
また、「特定の文字があれば」というのが、その文字列を含む、というのでなくセルの値がその文字列ならば、というのであれば、LookAt:=xlPart の部分を LookAt:=xlWhole に書き換えてください。

Sub DelLines()
  Dim R As Range
  Do
    Set R = ActiveSheet.Range("B:B").Find(What:="XXX", LookAt:=xlPart)
    If R Is Nothing Then Exit Sub
    R.EntireRow.Delete
  Loop
End Sub

QEXCELで作成した表(横)を表(縦)に変換ができますか。

EXCELで作表しましたが、横向きに作成した数値の入った表を縦向きに直す方法はどうすればできるか教えてくださいませんか。

Aベストアンサー

表を選択してコピーします。
他の場所か他のシートに、「編集」>「形式を選択して貼り付け」で「行列を入れ替える」にチェックを入れてOKを押します。

Q(VBAにて)日付でデータを抽出するやり方

ド素人なのですが、上司にマクロ作成を依頼され困っています。
下記に内容を記しますので、教えて下さい。
お願いします。

・VBAを使ってExcelで管理してある管理表(下記参照)を
「発生年月日」をキーにして
「開始月:yyyy/mm」と
「終了月:yyyy/mm」をそれぞれ入力して、コマンドボタンを押したら
 その指定した範囲内のみのデータを別シートに表示するように
 して欲しい。
(例)
開始月:2007/8
終了月:2007/11
→2007年8月~2007/11月分の全データが別シートに表示される)

・管理表はこんな感じです。(大体、月に4件ぐらいあります)
  発生年月日      件名    内容      完了日
  (yyyy/mm/dd) (障害件名)  (障害内容)  (yyyy/mm/dd)

よろしくお願いします。

Aベストアンサー

プログラム以外の知識
(1)エクセルの日付は、見た目年月日に見えているが、そのセルの値は日付セリアル値という(1900年1月1日から何番目の日かという正整数を持ってます。
ですから、開始月:2007/8は開始日:2007/8/1から、終了月:2007/11
は終了月:2007/11/30と考えて、日付でやる方法が生まれます。
(2)あるセルに日付があった場合、そこから年、月を取り出す関数があること。Year、Month関数です。
あと年数、月数で文字列と数値の区別に注意が必要です。
(3)フィルタなどのエクセル固有の機能があることも知っておくべきです。
VBAプログラムは上記3つの路線で考えることが可能です。
ーー
プログラムの知識
(1)データの最下行を知るコード
(2)全行総なめして判別を繰り返す手法を採る場合、繰り返し法
(3)他シートに書き出す法
(4)月末日を出すコード
ーーー
(1)の方式でやってみます。
下記は書式は移しません。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'----
d = sh1.Range("A65536").End(xlUp).Row
' MsgBox d
k = 2
f = sh2.Range("C1")
t1 = sh2.Range("D1")
t = DateSerial(Year(t1), Month(t1) + 1, 1) - 1
' MsgBox t
For i = 2 To d
If sh1.Cells(i, "A") >= f And sh1.Cells(i, "A") <= t Then
' MsgBox sh1.Cells(i, "A")
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
k = k + 1
'--以下C,D・・列分を必要分並べる
End If
Next i
End Sub
'---
Shwet2のA列は日付書式にする。
Sheet2のC1,D1は書式をy年m月にし、2007/9とかいれると値は2007/9/1になり、表示は2007年9月と見えます。
コマンドボタンの件はわかると思うが、
上記をクリックイベントのコードに挟む。
Private Sub CommandButton1_Click()
test01
End Sub

プログラム以外の知識
(1)エクセルの日付は、見た目年月日に見えているが、そのセルの値は日付セリアル値という(1900年1月1日から何番目の日かという正整数を持ってます。
ですから、開始月:2007/8は開始日:2007/8/1から、終了月:2007/11
は終了月:2007/11/30と考えて、日付でやる方法が生まれます。
(2)あるセルに日付があった場合、そこから年、月を取り出す関数があること。Year、Month関数です。
あと年数、月数で文字列と数値の区別に注意が必要です。
(3)フィルタなどのエク...続きを読む


人気Q&Aランキング