Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

854 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【77924】VBAによるデータ抽出等について 株太郎 16/2/13(土) 17:15

【77925】Re:VBAによるデータ抽出等について β 16/2/13(土) 19:42

【77926】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 0:27

【77927】Re:VBAによるデータ抽出等について β 16/2/14(日) 9:26

【77929】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 12:56

【77931】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 13:25

【77935】Re:VBAによるデータ抽出等について マナ 16/2/14(日) 15:36

【77936】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 16:33

【77928】Re:VBAによるデータ抽出等について β 16/2/14(日) 9:36

【77930】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 13:07

【77932】Re:VBAによるデータ抽出等について β 16/2/14(日) 14:07

【77934】Re:VBAによるデータ抽出等について 株太郎 16/2/14(日) 15:30

【77933】Re:VBAによるデータ抽出等について β 16/2/14(日) 14:09


	【77924】VBAによるデータ抽出等について

株太郎 - 16/2/13(土) 17:15 -


	引用なし

	パスワード

VBA初心者です。
データ処理をVBAで効率化したく色々調べてみましたが、
参考になるものを見つけ出せずに質問しました。

やりたいこと
・下記の株価データ（データ量は随時増加）からのデータ抽出
　抽出条件
　1.高値欄の色付けされたセルから、日付、高値欄の数値
　2.安値欄の色付けされたセルから、日付、安値欄の数値

・抽出されたデータ間にあるデータの個数を数える

■株価データ（わかり難いですが、数値ヨコの赤、青が色づけされたセルです）

日付　　　　　　時間　　　　始値　　高値　　安値　　　終値　　　　出来高
2015/12/30　　　14:05:00　　19060　　19070　 19060　　19060　　　　 94
2015/12/30　　　14:10:00　　19060　　19070赤 19060　　19060　　　　 59
2015/12/30　　　14:15:00　　19060　　19060　 19050　　 19060　　　　 31
2015/12/30　　　14:20:00　　19050　　19060　 19040　　 19050　　　　176
2015/12/30　　　14:25:00　　19050　　19060　 19040　　 19040　　　　115
2015/12/30　　　14:30:00　　19040　　19040　 19030　　 19030　　　　219
2015/12/30　　　14:35:00　　19040　　19040　 19030　　 19040　　　　 35
2015/12/30　　　14:40:00　　19040　　19040　 19020　　 19040　　　　296
2015/12/30　　　14:45:00　　19030　　19040　 19010　　 19010　　　　605
2015/12/30　　　14:50:00　　19020　　19030　 19010　　 19030　　　　333
2015/12/30　　　14:55:00　　19030　　19040　 19020　　 19040　　　　280
2015/12/30　　　15:00:00　　19040　　19040　 19010　　 19020　　　　849
2015/12/30　　　15:05:00　　19020　　19020　 19000　　 19010　　　　732
2015/12/30　　　15:10:00　　19010　　19010　 18980青　 19000　　　 2246
2015/12/30　　　16:35:00　　19010　　19020　 19010　　 19020　　　　392
2015/12/30　　　16:40:00　　19030　　19030赤 19030　　 19030　　　　107
2015/12/30　　　16:45:00　　19030　　19030　 19020　　 19020　　　　　8
2015/12/30　　　16:50:00　　19030　　19030　 19010　　 19010　　　　64
2015/12/30　　　16:55:00　　19010　　19020　 19010　　 19010　　　　 10
2015/12/30　　　17:00:00　　19020　　19020　 19020　　 19020　　　　 23
2015/12/30　　　17:05:00　　19020　　19020　 19000　　 19000　　　　287
2015/12/30　　　17:10:00　　19000　　19010　 19000　　 19000　　　　 80
2015/12/30　　　17:15:00　　19000　　19010　 19000　　 19000　　　　　6
2015/12/30　　　17:20:00　　19000　　19000　 18980青　 19000　　　　144
2015/12/30　　　17:25:00　　19000　　19020　 19000　　 19010　　　　 11　　
2015/12/30　　　17:30:00　　19010　　19010　 19000　　 19000　　　　 71

■完成系のイメージ
日付　　　　　　　高値　　　安値　セルの個数
2015/12/30　　　　19070
2015/12/30　　　　　　　　 18980　　　　　12
2015/12/30　　　　19030　　　　　　　　　　2
2015/12/30　　　　　　　　 18980　　　　　 8

以上、VBAの詳しい方、是非アドバイスを頂きたくよろしくお願いいたします。


	【77925】Re:VBAによるデータ抽出等について

β - 16/2/13(土) 19:42 -


	引用なし

	パスワード

▼株太郎さん：

株のことは詳しくないのですが、アップされたレイアウトと説明から推測して。
元シートが "Sheet1"、転記シートが "Sheet2" 。　
転記シート側のタイトルはあらかじめセットしてあるという前提です。

また、【赤】とか【青】ですけど、★印のところは、シート上に塗ってある実際の色番号に
直してください。

Sub Sample()
　　Dim red As Range
　　Dim blue As Range
　　Dim fR As Range
　　Dim fB As Range
　　Dim eR As Range
　　Dim eB As Range
　　Dim flagRB As Boolean
　　Dim f As Range
　　Dim e As Range
　　Dim c As Range
　　Dim pre As Range
　　Dim myColor As Long
　　Dim i As Long
　　Dim shT As Worksheet
　　
　　Set shT = Sheets("Sheet2")　　　'転記シート
　　i = 2　　　　　　　　　　　　　 '転記開始行番号
　　
　　With Sheets("Sheet1")　　　　　 '元シート
　　　　Set fR = .Range("D1")
　　　　Set fB = .Range("E1")
　　　　Set eR = .Range("D" & Rows.Count).End(xlUp)
　　　　Set eB = .Range("E" & Rows.Count).End(xlUp)
　　End With
　　
　　Do
　　　　flagRB = Not flagRB
　　　　If flagRB Then
　　　　　　Set f = fR
　　　　　　Set e = eR
　　　　　　myColor = vbRed　　 '★
　　　　Else
　　　　　　Set f = fB
　　　　　　Set e = eB
　　　　　　myColor = vbBlue　　'★
　　　　End If
　　　　
　　　　Application.FindFormat.Interior.Color = myColor
　　　　Set c = Range(f, e).Find(What:="", After:=f, LookIn:=xlFormulas, LookAt:=xlPart, SearchFormat:=True)
　　　　If c Is Nothing Then Exit Do
　　　　
　　　　shT.Cells(i, "A").Value = c.EntireRow.Range("A1").Value　　　　 '日付
　　　　If flagRB Then
　　　　　　shT.Cells(i, "B").Value = c.EntireRow.Range("D1").Value　　 '高値
　　　　Else
　　　　　　shT.Cells(i, "C").Value = c.EntireRow.Range("E1").Value　　 '安値
　　　　End If
　　　　
　　　　If Not pre Is Nothing Then shT.Cells(i, "D").Value = c.Row - pre.Row
　　　　
　　　　i = i + 1
　　　　
　　　　
　　　　If c.Row = eR.Row Then Exit Do
　　　　
　　　　Set fR = c.EntireRow.Range("D1")
　　　　Set fB = c.EntireRow.Range("E1")
　　　　Set pre = c
　　Loop
　　　　
End Sub


	【77926】Re:VBAによるデータ抽出等について

マナ - 16/2/14(日) 0:27 -


	引用なし

	パスワード

▼株太郎さん：
こんな風に考えてみました

１）データシートを新規ブックにコピー
２）高値が色付きセルなら、安値セルをクリアし、H列に行番号をセット
３）安値が色付きセルなら、高値セルをクリアし、H列に行番号をセット
４）H列が空白の行をオートフィルタで抽出し削除
５）H列の値から、セルの個数を計算（I列）
６）不要な列を削除

Sub test()
　　Dim i As Long
　　
　　Sheets("Sheet1").Copy　　'★データシート
　　
　　With ActiveSheet.Cells(1).CurrentRegion.Columns("A:H")
　　　　For i = 2 To .Rows.Count
　　　　　　If .Cells(i, "D").Interior.Color = vbBlue Then
　　　　　　　　.Cells(i, "E").ClearContents
　　　　　　　　.Cells(i, "H").Value = i
　　　　　　ElseIf .Cells(i, "E").Interior.Color = vbRed Then
　　　　　　　　.Cells(i, "D").ClearContents
　　　　　　　　.Cells(i, "H").Value = i
　　　　　　End If
　　　　Next

　　　　.AutoFilter
　　　　.AutoFilter Field:=8, Criteria1:="="
　　　　.Offset(1).EntireRow.Delete
　　　　.AutoFilter
　　　　.Interior.Color = xlNone

　　　　If .Rows.Count > 1 Then
　　　　　　With .Columns("I").Resize(.Rows.Count - 1).Offset(1)
　　　　　　　　.FormulaR1C1 = "=IF(R[-1]C[-1]="""","""",RC[-1]-R[-1]C[-1])"
　　　　　　　　.Value = .Value
　　　　　　End With
　　　　End If
　　　　.Cells(1, "I").Value = "セルの個数"
　　　　.Columns("F:H").Delete
　　　　.Columns("B:C").Delete
　　　　.Cells(1).Select
　　End With
　　　　　　
End Sub


	【77927】Re:VBAによるデータ抽出等について

β - 16/2/14(日) 9:26 -


	引用なし

	パスワード

▼マナさん：

なるほど、簡潔かつ効率がいいですねぇ。

ところで、きっと D列が赤でE列が青なんでしょうかね。


	【77928】Re:VBAによるデータ抽出等について

β - 16/2/14(日) 9:36 -


	引用なし

	パスワード

▼株太郎さん：

ところで、興味本位の質問で恐縮ですが、コメントしましたように、株式は詳しくありません。
私のような素人の理解では、始値　　　　高値　　　　安値　　　　終値　　　　出来高　といったものを
1日のスパンでイメージするんですが、アップされたデータは、そのスパンが5分間なんですよね。
（その時刻までの５分なのか、その時刻からの５分なのかはわかりませんけど）

そうした場合、なぜ2行目（最初のデータ）の 19070 が　赤（高値）ではないのかな？
なぜ、4行目（３つめのデータ）の 19050 が青（安値）ではないのかなと。

よければ、そのあたりのルールを教えていただけませんか。

それによっては、色を頼りの処理ではなく、金額の比較による高値、安値の抽出とリスティングが
可能になりそうな感じがするのですが。


	【77929】Re:VBAによるデータ抽出等について

マナ - 16/2/14(日) 12:56 -


	引用なし

	パスワード

▼β さん：
いつもありがとうございます。

>ところで、きっと D列が赤でE列が青なんでしょうかね。

そうでした。
ついでに修正です。

＞.Interior.Color = xlNone
　　↓
　.Interior.ColorIndex = xlNone


	【77930】Re:VBAによるデータ抽出等について

株太郎 - 16/2/14(日) 13:07 -


	引用なし

	パスワード

▼β さん：

アドバイスありがとうございます。
最初に頂いたVBAのコードを実行しましたが、sheet2への抽出はされませんでした。

注意いただいていました、
>★印のところは、シート上に塗ってある実際の色番号に直してください。
の部分は、色番号に直しました。

その後、ご質問頂いた内容ですが、
分析する時間軸はいろいろとありまして、仰るように１日もあれば、5分、15分、60分等、分析する人の裁量で変化します。

それで、色つきのセル（高値欄　赤【ピーク】、安値欄　青【ボトム】）は、複雑な計算の結果、高値欄であれば、前回のボトムからみて、計算上、今回が最もピークな価格を赤い色でセルを色付けしていています。
安値欄はその逆で、前回ピークからみて、計算上、今回が最もボトムな価格を青い色でセル色付けして識別しています。

同じ価格であっても、複雑な計算上、最もピーク、最もボトム解答しなければ、色付けして識別することはありません。

分かりにくくて申し訳けありません。

色付けされたセルが重要なポイントとなるため、やりたいことの内容が、色付けされたセルを起点としたデータ抽出を発想しました。

やりたいことの実現は難しそうでしょうか？

お手数をお掛けいたしますが、よろしくお願いいたします。


	【77931】Re:VBAによるデータ抽出等について

株太郎 - 16/2/14(日) 13:25 -


	引用なし

	パスワード

▼マナさん：

アドバイスありがとうございます。

さきほどの修正事項を反映させて、頂いたVBAを実行いたしましたが、エラー”400”いうのが出ました。

それと、理解力が乏しくてご迷惑をお掛けしてしまいますが、

>４）H列が空白の行をオートフィルタで抽出し削除

を赤と青　の間のデータ個数を計算できるのでしょうか？

お手数をお掛けいたしますが、よろしくお願いいたします。


	【77932】Re:VBAによるデータ抽出等について

β - 16/2/14(日) 14:07 -


	引用なし

	パスワード

▼株太郎さん：

色付けせル判定の意味は理解しました。

>>★印のところは、シート上に塗ってある実際の色番号に直してください。
>の部分は、色番号に直しました。

の上で

>最初に頂いたVBAのコードを実行しましたが、sheet2への抽出はされませんでした。

でしょうか？
実際の色番号とコード内色番号が同じなら、ちゃんと抽出されるはずですが？

ちなみに赤と青の色番号を教えてください。

>やりたいことの実現は難しそうでしょうか？

いやぁ・・・
アップしたコードで実現するはずなんですが・・・


	【77933】Re:VBAによるデータ抽出等について

β - 16/2/14(日) 14:09 -


	引用なし

	パスワード

▼株太郎さん：

ちなみにアップされた元データは A1から始まっているという前提です。


	【77934】Re:VBAによるデータ抽出等について

株太郎 - 16/2/14(日) 15:30 -


	引用なし

	パスワード

▼β さん：

お手数をお掛けしています。
　
色番号のところを再度見直して、誤りがあり修正して実行、成功しました。

今回、アドバイス頂いたことにより、データ抽出が非常に簡単に行えるように
なり、感謝しております。

ありがとうございました。


	【77935】Re:VBAによるデータ抽出等について

マナ - 16/2/14(日) 15:36 -


	引用なし

	パスワード

▼株太郎さん：

解決したようなので、時間に余裕があればご検討下さい。

>
>エラー”400”

ごめんなさい。原因がわかりません。
ステップ実行でどこでエラーになる確認できますか。
（繰り返し処理をしていますので、データ量を少なくしないと大変かも）
>

>
>>４）H列が空白の行をオートフィルタで抽出し削除
>
>を赤と青　の間のデータ個数を計算できるのでしょうか？

H列に色付きセルの行番号をセットしています。
この行番号の差がセルの数になりませんか？

わかりにくそうなところを少し修正してみました。

Sub test2()
　　Dim i As Long
　　
　　Sheets("Sheet1").Copy　　'★データシート
　　
　　With ActiveSheet.Cells(1).CurrentRegion.Columns("A:H")
　　　 .Cells(1, "H").Value = "作業列（行番号)"
　　　　For i = 2 To .Rows.Count
　　　　　　If .Cells(i, "D").Interior.Color = vbRed Then　 '★高値の色
　　　　　　　　.Cells(i, "E").ClearContents
　　　　　　　　.Cells(i, "H").Value = i
　　　　　　ElseIf .Cells(i, "E").Interior.Color = vbBlue Then　'★安値の色
　　　　　　　　.Cells(i, "D").ClearContents
　　　　　　　　.Cells(i, "H").Value = i
　　　　　　End If
　　　　Next

　　　　.AutoFilter
　　　　.AutoFilter Field:=8, Criteria1:="="
　　　　.Offset(1).EntireRow.Delete
　　　　.AutoFilter
　　　　.Interior.ColorIndex = xlNone

　　　　If .Rows.Count > 1 Then
　　　　　　With .Columns("I").Resize(.Rows.Count - 1).Offset(1)
　　　　　　　　.Formula = "=IF(H1=""作業列（行番号)"","""",H2-H1)"
　　　　　　　　.Value = .Value
　　　　　　End With
　　　　End If
　　　 .Cells(1, "I").Value = "セルの個数"
　　　　.Columns("F:H").Delete
　　　　.Columns("B:C").Delete
　　　　.Cells(1).Select
　　End With
　　　　　　
End Sub


	【77936】Re:VBAによるデータ抽出等について

株太郎 - 16/2/14(日) 16:33 -


	引用なし

	パスワード

▼マナさん：

お手数をお掛けしています。

β さんのアドバイスのところでも、私が誤っていたのですが、
　
色番号のところを再度見直して、今回、マナさんから頂いたものを実行、成功しました。

今回、お二方のアドバイスにより、やりたいことが簡潔に出来るのは、本当にありがたいことです。
また、異なった記述方法をアドバイス頂いたことにより、知識の幅が広がりました。

色々とありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

854 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free