VB6からExcel2002へアクセスしています。
エクセルで列方向(例えばA列)へB,B,B,A,A,A,A,A,C,C,C,C,B,B,B,B...
のように格納されているデーターがあります(3万~5万行)。
このデーター列から変化点を高速に検索する方法はありませんでしょうか。
現在は、For-Nextで1セルずつ比較しながら変化点を検索、抽出しているため、非常に時間がかかっています。
Findメソッドは調べた限り、できそうにありませんでした。
高速化できる方法をご存知の方いらっしゃいましたら、よろしくお願いします。
A 回答 (9件)
- 最新から表示
- 回答順に表示
No.9
- 回答日時:
#7,8です。
専門家では無いので、想像の域を出ませんが、VBAで下記の様なコードを実行すると、当方の遅いマシンで、50000回の倍精度浮動小数点数の計算にかかる時間は7~8msecでした。Variant型にしても、数割遅くなる程度でした。VBA恐るべし。
一方ローカルウィンドウなどで、ExcelのRange型を見ると、呆れるほど沢山の、多階層のメンバーを有する複雑なObjectである事が分かります。Excelのセルに計算をさせるときにかかる時間のほとんどはObjectとのやりとりの部分なのではないでしょうか。と、いう事で、Objectへの代入を一括で行う事で、高速化が図れるのだと想像します。
専門家の方がご覧になっていたら、補足をお願いします。
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()
Dim i As Long
Dim a As Double, b As Double, dbRet As Double
Call timeBeginPeriod(1)
Sleep 100
Debug.Print timeGetTime
For i = 1 To 50000
a = 10000.1
b = 9999.123
dbRet = Abs(a - b)
Next i
Debug.Print timeGetTime
Call timeEndPeriod(1)
End Sub
No.8
- 回答日時:
#7です。
それではExcelだけでやる方法にトライ。Sheet2のA1:B50001にデータをおきます。
1行目はA~C列に適当な見出しを付けます。例えばC1を「差」とします
A2:A50001は連番、B2:B50001は目的のデータとします。
Sheet1にフィルタオプションの条件を記します。
A1に「差」、A2に「>=100」等と条件を記します。
次のマクロを実行すると、C列の前データとの差が100以上のデータが抽出されます。実行時間はトータル1秒前後でした。範囲をまとめて処理するのがミソです。
Sub test()
Debug.Print Now
Sheets("Sheet2").Range("c3:c50001").Formula = "=abs(RC[-1]-R[-1]C[-1])"
'再計算させると悲惨な目に遭うので、式から値に置き換え
Sheets("Sheet2").Range("c3:c50001").Value = Sheets("Sheet2").Range("c3:c50001").Value
Debug.Print Now
Range("A1:C50001").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Sheets("Sheet1").Range("A1:A2"), Unique:=False
Debug.Print Now
End Sub
たびたび、ありがとうございます。
やはり「差分検出の式(いわゆる、微分といったところでしょうか)」という方法が一番高速でしょうか。
一行ずつ比較する方法が時間がかかるのは理解できるのですが、
回答いただいたような「エクセルに計算させる」方法が「極端」に高速な理由を知りたいです。
No.7
- 回答日時:
横道にずれますが、Excelのファイルで処理しないといけないんでしょうか。
試しに50,000件のデータで、Access2000でやってみました。49,999レコード目に特異値を設けて試験しました。ちなみに、2.4GのCeleronで、メモリは256MB、Windows2000です。1.Dlookupを使った重たいクエリ(1件毎に検索される?)約3分
こんなSQLです。
SELECT T_data.ID, T_data.data, Abs(DLookUp("data","T_data","ID=" & [ID]-1)-[data]) AS 差
FROM T_data
WHERE (((Abs(DLookUp("data","T_data","ID=" & [ID]-1)-[data]))>100));
2.VBA + ADOで、普通のBASICのやり方で差を求める場合、差の絶対値の算出に20秒、そのテーブルから一定以上の値を抽出するクエリは一瞬でした。
ご参考まで。
ありがとうございます。
私も、ACCESSが使えるといいと思っているのですが「諸般の事情」で、エクセルでやるしかないんです・・・
No.5
- 回答日時:
No.2です。
よく考えたらNo.4の回答内の並べ替えの部分は不要なので、以下で試してください。
Sub sample()
'excel用定数設定
Const xlUp = -4162
Const xlNumbers = 1
Const xlCellTypeFormulas = -4123
'
Dim xl As Object
Dim lastRow As Long
Dim d As Variant
Set xl = CreateObject("Excel.application")
'xl.Visible = True '表示する場合
xl.Workbooks.Open "c:\book1.xls" 'excelファイルを開く
With xl.ActiveWorkbook.ActiveSheet '開いた時のシートに対して
'With xl.ActiveWorkbook.Sheets("Sheet1") 'シート名で指定する場合
.Columns("B").Clear '結果列クリア
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 'A列の最終行を取得
.Range("B2:B" & lastRow).Formula = "=IF(A2<>A1,ROW(),"""")" '変化した行に行番号を表示する式を設定
.Columns("C").Clear '最終結果列クリア
.Range("B2:B" & lastRow).SpecialCells(xlCellTypeFormulas, xlNumbers).Copy .Range("C1") 'B列の計算式の数値のみC列に
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row 'C列の最終行を取得
d = xl.WorksheetFunction.Transpose(.Range("C1:C" & lastRow)) 'C列の最大行までの値を1次元配列に取り込む
xl.ActiveWorkbook.Close False 'ブックを保存せずに閉じる
xl.Quit 'excel終了
Set xl = Nothing 'excel変数破棄
'結果表示
MsgBox LBound(d) '最小添え字(1になる)
MsgBox UBound(d) '最大添え字
MsgBox d(LBound(d)) '最初の変化点
MsgBox d(UBound(d)) '最後の変化点
'もちろん途中も見れます
End With
End
End Sub
No.4
- 回答日時:
No.2です。
vb6から操作するなら以下ではどうでしょうか?
結果は配列dに入りますが、excelの関数使う関係上、d(1)-d(ubound(d))に入ります。
Sub sample()
'excel用定数設定
Const xlUp = -4162
Const xlPasteValues = -4163
Const xlAscending = 1
Const xlNo = 2
Const xlCellTypeConstants = 2
Const xlNumbers = 1
'
Dim xl As Object
Dim lastRow As Long
Dim d As Variant
Set xl = CreateObject("Excel.application")
'xl.Visible = True'表示する場合
xl.workbooks.open "c:\book1.xls" 'excelファイルを開く
With xl.ActiveWorkbook.ActiveSheet '開いた時のシートに対して
'With xl.ActiveWorkbook.Sheets("Sheet1") 'シート名で指定する場合
.Columns("B").Clear '結果列クリア
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 'A列の最終行を取得
.Range("B2:B" & lastRow).Formula = "=IF(A2<>A1,ROW(),"""")" '変化した行に行番号を表示する式を設定
.Range("B1").Resize(lastRow, 1).Copy '計算式を値にするためにコピー
.Range("B1").Resize(lastRow, 1).PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
.Range("B1").Resize(lastRow, 1).Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlNo '並び替え(数値を前に移動して空白を後ろに移動)
.Columns("C").Clear '最終結果列クリア
.Range("B1").Resize(lastRow, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Copy .Range("C1") '最初の結果列の値のセルのみ(""セルを除く)をC列にコピー
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row 'C列の最終行を取得
d = xl.WorksheetFunction.Transpose(.Range("C1:C" & lastRow)) 'C列の最大行までの値を1次元配列に取り込む
xl.ActiveWorkbook.Close False 'ブックを保存せずに閉じる
xl.quit 'excel終了
Set xl = Nothing 'excel変数破棄
'結果表示
MsgBox LBound(d) '最小添え字(1になる)
MsgBox UBound(d) '最大添え字
MsgBox d(LBound(d)) '最初の変化点
MsgBox d(UBound(d)) '最後の変化点
End With
End
End Sub
No.3
- 回答日時:
VB6で動くか分かりませんが参考までに。
Dim a(,) As Object 'シートA列のデータ。Variant型?
Dim b() As Integer '先頭位置を確保
Dim n As Integer 'データ数
n = 50
a = objExcel.Range("A1:A" & CStr(n)).Value 'objExcelは作成済みとする
ReDim b(n)
For i = 1 To n - 1
If a(i, 1) <> a(i + 1, 1) Then
b(j) = i + 1
j = j + 1
End If
Next
ReDim Preserve b(j - 1)
ありがとうございます。
試してみたのですが、
現状方法:15分
提案方法:15分
とほとんど差はありませんでした。
何か妙案があればいいのですが。
No.2
- 回答日時:
こんなのではどうでしょうか?
B列に変化行を表示します。
Sub sample()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row 'A列の最終行を取得
Columns("B").Clear '結果列クリア
Range("B2:B" & Rows.Count).Formula = "=IF(A2<>A1,ROW(),"""")" '変化した行に行番号を表示する式を設定
Columns("B").Copy '計算式を値にするためにコピー
Columns("B").PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
Columns("B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo '並び替え(数値を前に移動して空白を後ろに移動)
End Sub
ただB列にゴミが残るので、邪魔のようならC列を使って掃除します。
Sub sample()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row 'A列の最終行を取得
Columns("B").Clear '結果列クリア
Range("B2:B" & Rows.Count).Formula = "=IF(A2<>A1,ROW(),"""")" '変化した行に行番号を表示する式を設定
Columns("B").Copy '計算式を値にするためにコピー
Columns("B").PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
Columns("B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo '並び替え(数値を前に移動して空白を後ろに移動)
Columns("C").Clear '最終結果列クリア
Columns("B").SpecialCells(xlCellTypeConstants, xlNumbers).Copy Range("C1") '最初の結果列の値のセルのみ(""セルを除く)をC列にコピー
Columns("B").Delete '最初の結果列を削除
End Sub
なるほど。
先にエクセル上で変化点検出を行っておくのですね。
エクセルのシート上には他にも多量のデーターが存在しますので、
WorkSheetオブジェクトかCellsオブジェクトで同じことができないか試してみます。
ありがとうございました。
No.1
- 回答日時:
もっと具体的に説明しないと分かる人はいないでしょう。
>B,B,B,A,A,A,A,A,C,C,C,C,B,B,B,B...
まず、A,B,C・・・等は数値ですか文字列ですか。
同じ文字は同一の内容が連続しているという意味ですか?
変化点の定義は何ですか?
この回答への補足
お世話になります。
>まず、A,B,C・・・等は数値ですか文字列ですか。
文字列もありますし、数値(整数)もあります。
>同じ文字は同一の内容が連続しているという意味ですか?
はい、そのとおりです。不定の個数が連続しています。
>変化点の定義は何ですか?
同じデーターが連続している最後(または次の先頭)を検出したいです。
>もっと具体的に説明しないと分かる人はいないでしょう。
決めつけるのもどうかと思います。
少なくともお2方からはアドバイスをいただけましたし、
自身も「なるほど、いけるかも」と思い、試してみました。
「万人にわかる説明」という言葉があります。
たしかに、この質問はそうではなかったかも知れません。
しかし、琴線にふれて的確な回答をいただけたことも事実です。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelマクロの表示のExcel内をfindで検索 3 2022/06/15 20:07
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Excel(エクセル) エクセルの印刷範囲をページ単位で可変にする方法 3 2022/05/23 13:04
- Excel(エクセル) Excelでの検索結果を含む行だけを表示させたい 5 2023/03/10 17:08
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- 物理学 微分方程式の物理現象への適用について 3 2023/05/14 12:22
- その他(Microsoft Office) excel テーブル 4 2023/03/18 16:11
- Outlook(アウトルック) 標準アカウントをOUTLOOKアプリに登録するとほかのアカウントのメールもこのアドレスに受信される 1 2023/02/03 20:34
- Google Maps iPhoneのGoogle検索窓を通常の大きさに 戻す方法を教えて頂けませんか?(切実) 日本全国の 2 2022/10/02 02:08
- Visual Basic(VBA) vba 等間隔の列に対しての計算 6 2022/05/17 20:15
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
マクロ 最終列をコピーして最終...
-
Cellsのかっこの中はどっちが行...
-
vba 2つの条件が一致したら...
-
文字列の結合を空白行まで実行
-
VBA指定行削除
-
VBAを使って検索したセルをコピ...
-
vbaでシートより100より大きい...
-
Changeイベントでの複数セルの...
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
VBマクロ 色の付いたセルを...
-
エクセルで結合セルがあるため...
-
vba 重複データ合算
-
エクセルVBA シートモジュール...
-
空白セルをとばして転記
-
rowsとcolsの意味
-
VBAで列の再表示設定
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
B列の最終行までA列をオート...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
VBAを使って検索したセルをコピ...
-
文字列の結合を空白行まで実行
-
VBA指定行削除
-
VBAのFind関数で結合セルを検索...
-
IIF関数の使い方
-
VBA 何かしら文字が入っていたら
-
マクロ 最終列をコピーして最終...
-
エクセルについて
-
【VBA】2つのシートの値を比較...
-
URLのリンク切れをマクロを使っ...
-
データグリッドビューの一番最...
-
Changeイベントでの複数セルの...
-
空白セルをとばして転記
-
rowsとcolsの意味
-
エクセルVBAにて =A1=B1とすれ...
おすすめ情報