Excel VBA 質問スレ Part33
レス数が1000を超えています。これ以上書き込みはできません。
0001デフォルトの名無しさん
2013/10/17(木) 22:04:40.64___
___ /____ヽ ____
/____\ | |´・ω・`| | /___ヽ
.l |´・ω・`| ニX二 . ̄ ̄ ̄ 二X二 |´・ω・`| l 俺たちに任せろ
!、 ̄ ̄ ̄ ヽ | | /  ̄ ̄ ̄/
ヽ_/ヽ、 ヽ__) \__/\_/. /_/ ノヽ_/
 ̄  ̄ ̄
前スレ
Excel VBA 質問スレ Part32
http://toro.2ch.net/test/read.cgi/tech/1381151717/
このスレはコード書き込みOKです。
作成依頼もOKですが、作成依頼限定ではありません。
コードが嫌な人はこちらのスレへ
http://toro.2ch.net/test/read.cgi/tech/1381151995/l50
0951945
2014/06/27(金) 01:01:09.42ID:tthd8i7m無理ですか ありがとうございます
この前に少し重い処理があって それを含めて 全体をもっと効率化できないかと考えておりました
重い処理の方をもっと効率化するように考えてみます。
0952デフォルトの名無しさん
2014/06/27(金) 01:16:52.94ID:MwZdRGeIそれはおまえが決めることじゃない
どんな方法を望んでいるかは質問者にしかわからない
0953デフォルトの名無しさん
2014/06/27(金) 01:18:30.71ID:dGXFzF3sシンプルとか言い出したのおまえだろ
0955デフォルトの名無しさん
2014/06/27(金) 01:45:43.30ID:fv43ADTPたぶんベタにやるしかない。速度差なんて大差無いと思うが
ベタにやってみた
0956デフォルトの名無しさん
2014/06/27(金) 01:47:19.39ID:fv43ADTP前半
Function DataArea(checkarea As Range) As Range
Dim retarea As Range
Dim row1 As Long, col1 As Long, row2 As Long, col2 As Long
Dim r As Range, i As Long
'上
For Each r In checkarea.Rows
Debug.Print "r1 count=" & WorksheetFunction.CountA(r)
If WorksheetFunction.CountA(r) > 0 Then
row1 = r.Row
Exit For
End If
Next
'左
For Each r In checkarea.Columns
If WorksheetFunction.CountA(r) > 0 Then
col1 = r.Column
Exit For
End If
Next
If row1 = 0 Or col1 = 0 Then
MsgBox "範囲内にデータなし"
Exit Function
End If
0957デフォルトの名無しさん
2014/06/27(金) 01:47:49.81ID:fv43ADTP'下
For i = checkarea.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(checkarea.Rows(i)) > 0 Then
row2 = checkarea.Rows(i).Row
Exit For
End If
Next
'右
For i = checkarea.Columns.Count To 1 Step -1
If WorksheetFunction.CountA(checkarea.Columns(i)) > 0 Then
col2 = checkarea.Columns(i).Column
Exit For
End If
Next
With checkarea.Worksheet
Set retarea = .Range(.Cells(row1, col1), .Cells(row2, col2))
End With
Set DataArea = retarea
End Function
0958デフォルトの名無しさん
2014/06/27(金) 01:51:47.61ID:fv43ADTPMsgBox DataArea(Selection).Address
とかで行けるんじゃね
問題になるほど遅いとは思わんが
0959デフォルトの名無しさん
2014/06/27(金) 01:52:10.06ID:WBIkvaOnもしも条件にあったものをArray1から抜き出してArray2をつくるということなら
Array2はインデックスだけにしてそれを使ってArray1にアクセスするというのはだめですか?
0960935
2014/06/27(金) 02:00:43.32ID:fo8RbvYeCurrentRejion は、関係なかった。(というか>>940の指摘どおりCurrentRejionでは対応出来ない部分があった)Findを4回でどうやるのかも分からないからベタにやった。
適当な範囲をセレクトした状態で以下のマクロを実行すると、データがある範囲だけを包含した矩形の領域をセレクトして終了する……はず。<=ちょっと自信ない
Sub test()
Dim wf As WorksheetFunction
Dim rw_cnt As Long, cl_cnt As Long, st_rw As Long, ed_rw As Long, st_cl As Long, ed_cl As Long
Set wf = Application.WorksheetFunction
With Selection
rw_cnt = .Rows.Count
cl_cnt = .Columns.Count
For st_rw = 1 To rw_cnt
If wf.CountA(.Rows(st_rw)) > 0 Then Exit For
Next st_rw
If st_rw > rw_cnt Then
MsgBox "Err:NoData"
Exit Sub
End If
For ed_rw = rw_cnt To 1 Step -1
If wf.CountA(.Rows(ed_rw)) > 0 Then Exit For
Next ed_rw
For st_cl = 1 To cl_cnt
If wf.CountA(.Columns(st_cl)) > 0 Then Exit For
Next st_cl
For ed_cl = cl_cnt To 1 Step -1
If wf.CountA(.Columns(ed_cl)) > 0 Then Exit For
Next ed_cl
Range(.Cells(st_rw, st_cl), .Cells(ed_rw, ed_cl)).Select
End With
Set wf = Nothing
End Sub
0961935
2014/06/27(金) 02:02:55.35ID:fo8RbvYe0962デフォルトの名無しさん
2014/06/27(金) 02:15:13.27ID:MwZdRGeISub Macro1()
With Selection
If WorksheetFunction.CountA(.Cells) Then
r1 = .Find(What:="*", After:=.Cells(.Count), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
r2 = .Find(What:="*", SearchDirection:=xlPrevious).Row
c1 = .Find(What:="*", After:=.Cells(.Count), SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
c2 = .Find(What:="*", SearchDirection:=xlPrevious).Column
Range(Cells(r1, c1), Cells(r2, c2)).Select
End If
End With
End Sub
0963デフォルトの名無しさん
2014/06/27(金) 02:23:22.97ID:fo8RbvYeなるほど、SearchOrderとSearchDirectionを上手く使ってますね。
あと、何気にAfterも。
可読性がちょっと犠牲になるけど、c1とc2の順番を逆にしたら
ほんのちょびっと(SearchDirectionの指定一回分)だけコード短く出来ますな。
0964デフォルトの名無しさん
2014/06/27(金) 02:43:45.05ID:MwZdRGeISearchDirectionはデフォルト値が記憶されるんだっけ?
0965デフォルトの名無しさん
2014/06/27(金) 02:44:41.44ID:MwZdRGeISub Macro2()
With WorksheetFunction
If .CountA(Selection) = 0 Then Exit Sub
r1 = Selection.Row
c1 = Selection.Column
r2 = Selection(Selection.Count).Row
c2 = Selection(Selection.Count).Column
While .CountA(Range(Cells(r1, c1), Cells(r1, c2))) = 0
r1 = r1 + 1
Wend
While .CountA(Range(Cells(r2, c1), Cells(r2, c2))) = 0
r2 = r2 - 1
Wend
While .CountA(Range(Cells(r1, c1), Cells(r2, c1))) = 0
c1 = c1 + 1
Wend
While .CountA(Range(Cells(r1, c2), Cells(r2, c2))) = 0
c2 = c2 - 1
Wend
End With
Range(Cells(r1, c1), Cells(r2, c2)).Select
End Sub
0966デフォルトの名無しさん
2014/06/27(金) 02:57:21.18ID:WMnmrq5J上手く使ったというか、本人も言ってる通り
「愚直に調べる」方法の一つをコードにしただけの話でしょ
でも愚直なのが一番確実だし、速度的にも十分じゃね?
0967945
2014/06/27(金) 02:59:21.01ID:tthd8i7mえっとごめんなさい
>2重ループにしないで(For j=・・・・・なしに)配列を一発で
が主眼で if とある条件 then
をつけないと Arry2 = Arry1 でいいじゃんとかいわれそうで付けた
説明不足で申し訳ありません
実際の処理は以下なんです
当初これで質問しようとしてたんだけどここまで聞くのは どうなのかって感じでもっとシンプルな質問に変えたんです(^^;
(ソート処理をFunction化したものの 一部なんだけどね)
配列 Arry(1 TO n,1 TO m)
配列 Sortdata(1 TO n)・・・・実際は2次元配列だけど 説明上1次元としている
があって
配列Sortdataは 1〜n の 数値が 入っていて(同じ数値は入っていない) 配列Arryのインデックス値に対応してます
配列Dataを元に 配列Arrayの配置を変えたいのです。
Sortdata(1) = 100 なら 配列Arry(100, j) → 配列Arry(1, j)
Sortdata(5) = 200 なら 配列Arry(200, j) → 配列Arry(5, j)って感じで
※配列Arryのある列をキーにして昇順になるように 配列Sortdataが作られていると考えて下さい。
'Orgin配列へ書戻し
Arry_Copy = Arry
For i = LBound(Sortdata, 1) To UBound(Sortdata, 1)
For j = LBound(Arry, 2) To UBound(Arry, 2)
Arry(i, j) = Arry_Copy(Sortdata(i), j)
Next
Next
PS. ソート処理本体を バブルソート から クイックソート に変えようとアルゴリズム勉強中です(^^
0968924
2014/06/27(金) 03:09:40.07ID:tG/H6ykx作って頂いて大変感謝しています。
早速試してみましたところ、全て期待通り動きました。感激です。
せっかく作ってもらっておきながら、気になった点を言いますと、
うっかりシート全体を選択して実行すると(EXCEL2010)、
>>956
>>960
10秒くらいかかりました。(わたしのパソコンが遅いのかもしれませんが)
>>962
>>965
オーバーフローしました。
もし解決方法が有りましたら教えてください。
シート全選択時でも1秒以内くらいが理想です。
0969デフォルトの名無しさん
2014/06/27(金) 03:11:24.73ID:MwZdRGeIScreenUpdating = Falseして、A1:Z100を選択した状態で10000回ずつ実行
>>956 40秒
>>960 19秒
>>962 0秒
>>965 10秒
0970デフォルトの名無しさん
2014/06/27(金) 03:19:28.93ID:fo8RbvYe指定する度にその設定が保存される仕様でしたよね、
たしかヘルプにはそんな様な事が書いてあったと思います。
だからr2とC2はDirectionが同じなのでOrderだけ指定すれば良くて、
c2からc1でDirectionの指定でいけたはずだな、と。(確かめてないですけど。)
>>966
すいません。
俺には思い付けなかったんです。
だから上手い手だなと思いました。
>>967
見当違いかもしれないけどジャグ配列ってのが参考になるかもです。
配列の配列とも言う奴です。
俺は使ったことがないのでよく分からないから間違ってたら許してください。
0971デフォルトの名無しさん
2014/06/27(金) 03:38:56.47ID:MwZdRGeIすまん、全選択は想定の範囲外だった
オーバーフローの原因は潰した
スピードも十分のはず
Sub Macro_962_2()
With Selection
If WorksheetFunction.CountA(.Cells) Then
Set c = .Cells(1).Offset(.Rows.Count - 1, .Columns.Count - 1)
r1 = .Find(What:="*", After:=c, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
r2 = .Find(What:="*", SearchDirection:=xlPrevious).Row
c1 = .Find(What:="*", After:=c, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
c2 = .Find(What:="*", SearchDirection:=xlPrevious).Column
Range(Cells(r1, c1), Cells(r2, c2)).Select
End If
End With
End Sub
0972デフォルトの名無しさん
2014/06/27(金) 03:43:06.73ID:MwZdRGeIヘルプじゃなくて悪いけど、ここにはSearchOrderは記憶されると書いてある
つまりSearchDirectionは記憶されないようだ
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_find.html
ヘルプでは発見できんかった
0973デフォルトの名無しさん
2014/06/27(金) 03:50:36.34ID:MwZdRGeIそれは知らんかった
0974970
2014/06/27(金) 04:03:10.21ID:fo8RbvYeあ、ホントだ。Directionは記憶されないんですね。
ちゃんと確認してませんでした。ごめんなさい。
http://msdn.microsoft.com/ja-jp/library/office/ff839746(v=office.15).aspx
でもそうすると、おそらくDirectionには規定値が存在しますよね?
省略可能なパラメータですし。
多分xlNextがデフォだと思いますが、
それの指定は省略できそうですね。<=まだ懲りてない
あと、これまた確認してなくてあてずっぽうですが、
変数の宣言で明示的にLong型にしたほうがVarantで使うより早くならないですかね?
(うちのPCは未だにExcel2000なんで、全領域指定しても全然範囲が狭いんで処理時間掛かるか試せないんです。)
0975デフォルトの名無しさん
2014/06/27(金) 04:08:49.44ID:MwZdRGeIExcelの機能をフルに使って、A列にインデックス、B列以降にデータを入れて
こんな感じでソートすれば一発で並べ替えできるけど、どうしてもVBAだけでやらないとだめ?
Range("A1:A100") = SortData
Range("B1:Z100") = Arry1
Worksheets("Sheet1").Sort
Arry2 = Range("B1:Z100")
0976デフォルトの名無しさん
2014/06/27(金) 04:20:34.26ID:vLpfuBhO一瞬で終わる処理の実行時間を測るには、Subを1000回呼んで時間を1000で割る
0977デフォルトの名無しさん
2014/06/27(金) 04:36:07.16ID:fv43ADTPシート全選択で、実際にデータ入ってる範囲はどのくらいなんだ?
つか今気づいたんだが、(一旦保存して開き直して)UsedRange見れば良いんじゃないか
0978945
2014/06/27(金) 04:39:09.43ID:tthd8i7mたしかにそれでも出来るけど
それ用のシート作らんとだめだし処理速度的にどうなんだろうか
配列内ソートの方が圧倒的に早いと思うんだけど
数百件程度のソートでは低速といわれてるバブルソートでも使えたけど
数千件のソートで処理速度的に不満が出てきたので効率化できないかなと
>>975 のやり方も含めて検討してみる ありがとう
あとは個人的な興味もありクイックソートも勉強中してみるっス
さて さすがに眠いな そろそろ仮眠タイムなので寝るっす
ではでは
0979デフォルトの名無しさん
2014/06/27(金) 05:07:04.04ID:81jca32sUsedRangeじゃだめ
最初の質問をよく読め
0980デフォルトの名無しさん
2014/06/27(金) 05:17:01.03ID:jgnIvu2AVBAには配列の一部分をまとめてコピーする方法がないんで、ワークシートに展開した方が速そうに思えるけどなあ
もしVBAだけで高速にソートするのが目的なら、単純な2次元配列にせずにVariant型の配列にするとか、
データをコピーせずにインデックス経由でアクセスするとか、根本的にデータ構造やアルゴリズムを工夫しないと
0981デフォルトの名無しさん
2014/06/27(金) 06:15:06.07ID:MwZdRGeIごめん、実際に試してみたら、単純なForの二重ループの方がワークシートよりずっと速かったわ
20倍ぐらい差があった
0982デフォルトの名無しさん
2014/06/27(金) 06:17:38.59ID:MwZdRGeIパラメータ省略ついでに、重そうな関数の呼び出しを1回減らして気休めレベルのスピードアップ
Sub Macro_962_3()
With Selection
Set c = .Cells(1).Offset(.Rows.Count - 1, .Columns.Count - 1)
Set f = .Find(What:="*", After:=c, SearchOrder:=xlByRows)
If Not f Is Nothing Then
r1& = f.Row
r2& = .Find(What:="*", SearchDirection:=xlPrevious).Row
c1& = .Find(What:="*", After:=c, SearchOrder:=xlByColumns).Column
c2& = .Find(What:="*", SearchDirection:=xlPrevious).Column
Range(Cells(r1&, c1&), Cells(r2&, c2&)).Select
End If
End With
End Sub
0983924
2014/06/27(金) 13:12:34.79ID:tG/H6ykxお返事おそくなりました。
たびたび改良ありがとうございました。
完璧に動きました。私の希望通りの動きです。
Findのテクニックも大変勉強になりました。
重ねてお礼申し上げます。
0984970
2014/06/27(金) 13:25:59.66ID:fo8RbvYeお呼びでないかもしれませんが、ジャグ配列のサンプルコード書きました。
こんな事がしたいのではありませんか?
Sub jagtest()
Dim tmp As Variant
Dim ary1 As Variant
Dim ary2 As Variant
Dim r As Long, c As Long
'サンプル用に2次元配列変数 ary1(1 to 500,1 to 100) をジャグ配列で作成
ReDim tmp(1 To 500)
ReDim ary1(1 To 100)
ReDim ary2(1 To 100)
With ThisWorkbook.Sheets(1)
For c = 1 To 100
For r = 1 To 500
'配列内のデータにはとりあえずセルのアドレスを使用
tmp(r) = .Cells(r, c).Address
Next r
ary1(c) = tmp
Next c
End With
stop
'ここまではサンプル用の配列変数を用意しただけ、ここからがジャグ配列の操作
For c = 1 To 100
ary2(c) = ary1(101 - c)
Next c
stop
'ary1とary2をウォッチ式とかで確認してください
End Sub
0985デフォルトの名無しさん
2014/06/27(金) 13:41:29.31ID:TCJgScNN0986970
2014/06/27(金) 13:45:07.18ID:fo8RbvYeary1(100,500)ではなく、ary1(100)(500)のようにしないとダメです。
あと、多分まとめて操作できるのは片方の要素(今回は最初の100の要素の方)だけです。
ところで、どなたかそろそろ次スレお願いします。
0987970
2014/06/27(金) 13:54:03.22ID:fo8RbvYeサンプルコード内の注釈が間違ってた……orz
ary1もary2もサイズは(500,100)ではなく(100,500)です。
連投すみませんでした。
0988911
2014/06/27(金) 13:54:16.09ID:e5TZuaT8再起動した後やってみたら上手く行った
何度やっても上手く行かなかったのに、原因不明
0989945
2014/06/27(金) 14:55:39.03ID:tthd8i7m>>967でもちょっと書いたけど
>(ソート処理をFunction化したものの 一部なんだけどね)
各プロシージャで使われる共通Functionなんです
なんでIn/Outの配列仕様は変えたくないのです(あっちこち変更しないとだから)
そのごく一部の処理で 元々数百件のデータを扱うもりで書いた処理が
データ量増加で 数千件に肥大してまい処理時間がかかるようになり
その主要因が 件の共通Functionだったのです。
とは言えそもそも 呼び足し元の処理自体もデータ量増加に対応出来てない部分もあるんで
>>980さんの言われるとおり 根本から見直したほうがよさそうです(D/B利用も含めて)
>>984さん
そうゆう手法もありですね今後の参考にさせてもらいます。
0990デフォルトの名無しさん
2014/06/27(金) 19:37:16.88ID:51fPEK/Z0991デフォルトの名無しさん
2014/06/28(土) 05:27:46.68ID:UFon7Qh20992デフォルトの名無しさん
2014/06/28(土) 16:02:46.50ID:CYmFK5pL遠慮なく埋めてくれ。
Excel VBA 質問スレ Part34
http://peace.2ch.net/test/read.cgi/tech/1403911485/
0993デフォルトの名無しさん
2014/06/28(土) 16:59:56.07ID:x8pWVUAe乙です
0994デフォルトの名無しさん
2014/06/28(土) 20:46:27.10ID:18/3jPkpおつ
0995デフォルトの名無しさん
2014/06/28(土) 21:32:22.70ID:S4simBtK0996デフォルトの名無しさん
2014/06/28(土) 21:33:59.74ID:87/kSllN自分なりに検索してみたんですけど見つからなかったので質問します
Windows7、Excel2010
ある列に文字が並んでいて、その文字に対応させた文字を同じ行の隣の列に表示させることはできますか?
例えば
A
B
A
A
A
B
のように一列に文字が並んでいて、Aの隣の列に1、Bの隣の列に2と表示させたいです
検索するときのキーワードだけでもいいので教えてほしいです
0997デフォルトの名無しさん
2014/06/28(土) 21:40:13.41ID:CYmFK5pLEXCELの数式だけで片付きそうなもんだけど、
VBAでやりたい理由が何かあるの?
0998デフォルトの名無しさん
2014/06/28(土) 21:47:06.54ID:QPLRDCyXループ if
0999デフォルトの名無しさん
2014/06/28(土) 21:53:46.84ID:87/kSllN調べてみたらVLOOKUPというものでできそうですね
こういうのはVBAでやるものだと思い込んでました
ありがとうございます
>>998
ありがとうございます
1000デフォルトの名無しさん
2014/06/28(土) 21:54:55.58ID:xYrnaOxY10011001
Over 1000Threadもう書けないので、新しいスレッドを立ててくださいです。。。
レス数が1000を超えています。これ以上書き込みはできません。