トップページtech
1001コメント417KB

Excel VBA 質問スレ Part33

レス数が1000を超えています。これ以上書き込みはできません。
0001デフォルトの名無しさん2013/10/17(木) 22:04:40.64
ExcelのVBAに関する質問スレです

                   ___
       ___      /____ヽ      ____
      /____\    | |´・ω・`| |    /___ヽ
      .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
09519452014/06/27(金) 01:01:09.42ID:tthd8i7m
>>948
無理ですか ありがとうございます

この前に少し重い処理があって それを含めて 全体をもっと効率化できないかと考えておりました
重い処理の方をもっと効率化するように考えてみます。
0952デフォルトの名無しさん2014/06/27(金) 01:16:52.94ID:MwZdRGeI
>>950
それはおまえが決めることじゃない
どんな方法を望んでいるかは質問者にしかわからない
0953デフォルトの名無しさん2014/06/27(金) 01:18:30.71ID:dGXFzF3s
>>952
シンプルとか言い出したのおまえだろ
09549242014/06/27(金) 01:33:18.48ID:tG/H6ykx
>>952
出来るだけ高速な方法でお願いします。
0955デフォルトの名無しさん2014/06/27(金) 01:45:43.30ID:fv43ADTP
>>954
たぶんベタにやるしかない。速度差なんて大差無いと思うが
ベタにやってみた
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:fv43ADTP
これでたとえばセル範囲選択して
MsgBox DataArea(Selection).Address
とかで行けるんじゃね
問題になるほど遅いとは思わんが
0959デフォルトの名無しさん2014/06/27(金) 01:52:10.06ID:WBIkvaOn
>>945
もしも条件にあったものをArray1から抜き出してArray2をつくるということなら
Array2はインデックスだけにしてそれを使ってArray1にアクセスするというのはだめですか?
09609352014/06/27(金) 02:00:43.32ID:fo8RbvYe
>>924
CurrentRejion は、関係なかった。(というか>>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
09619352014/06/27(金) 02:02:55.35ID:fo8RbvYe
被っちゃった……orz
0962デフォルトの名無しさん2014/06/27(金) 02:15:13.27ID:MwZdRGeI
スピードはわからんけど、言い出した手前、俺もFind 4回のコード貼っとく

Sub 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
>>962
なるほど、SearchOrderとSearchDirectionを上手く使ってますね。
あと、何気にAfterも。

可読性がちょっと犠牲になるけど、c1とc2の順番を逆にしたら
ほんのちょびっと(SearchDirectionの指定一回分)だけコード短く出来ますな。
0964デフォルトの名無しさん2014/06/27(金) 02:43:45.05ID:MwZdRGeI
>>963
SearchDirectionはデフォルト値が記憶されるんだっけ?
0965デフォルトの名無しさん2014/06/27(金) 02:44:41.44ID:MwZdRGeI
ついでにループ4回で調べる方法も作ってみた

Sub 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
>>963
上手く使ったというか、本人も言ってる通り
「愚直に調べる」方法の一つをコードにしただけの話でしょ

でも愚直なのが一番確実だし、速度的にも十分じゃね?
09679452014/06/27(金) 02:59:21.01ID:tthd8i7m
>>959
えっとごめんなさい
>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. ソート処理本体を バブルソート から クイックソート に変えようとアルゴリズム勉強中です(^^
09689242014/06/27(金) 03:09:40.07ID:tG/H6ykx
みなさんありがとうございます。こんな夜中にすぐにプログラムを
作って頂いて大変感謝しています。
早速試してみましたところ、全て期待通り動きました。感激です。
せっかく作ってもらっておきながら、気になった点を言いますと、
うっかりシート全体を選択して実行すると(EXCEL2010)、
>>956
>>960
10秒くらいかかりました。(わたしのパソコンが遅いのかもしれませんが)

>>962
>>965
オーバーフローしました。

もし解決方法が有りましたら教えてください。
シート全選択時でも1秒以内くらいが理想です。
0969デフォルトの名無しさん2014/06/27(金) 03:11:24.73ID:MwZdRGeI
ベンチマーク
ScreenUpdating = Falseして、A1:Z100を選択した状態で10000回ずつ実行

>>956 40秒
>>960 19秒
>>962 0秒
>>965 10秒
0970デフォルトの名無しさん2014/06/27(金) 03:19:28.93ID:fo8RbvYe
>>964
指定する度にその設定が保存される仕様でしたよね、
たしかヘルプにはそんな様な事が書いてあったと思います。

だからr2とC2はDirectionが同じなのでOrderだけ指定すれば良くて、
c2からc1でDirectionの指定でいけたはずだな、と。(確かめてないですけど。)

>>966
すいません。
俺には思い付けなかったんです。
だから上手い手だなと思いました。

>>967
見当違いかもしれないけどジャグ配列ってのが参考になるかもです。
配列の配列とも言う奴です。
俺は使ったことがないのでよく分からないから間違ってたら許してください。
0971デフォルトの名無しさん2014/06/27(金) 03:38:56.47ID:MwZdRGeI
>>968
すまん、全選択は想定の範囲外だった
オーバーフローの原因は潰した
スピードも十分のはず

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
>>970
ヘルプじゃなくて悪いけど、ここにはSearchOrderは記憶されると書いてある
つまりSearchDirectionは記憶されないようだ
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_find.html

ヘルプでは発見できんかった
0973デフォルトの名無しさん2014/06/27(金) 03:50:36.34ID:MwZdRGeI
SearchDirectionを省略するとxlNextと見なされるということは、いちいち書かなくてもいいのか
それは知らんかった
09749702014/06/27(金) 04:03:10.21ID:fo8RbvYe
>>972
あ、ホントだ。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:MwZdRGeI
>>967
Excelの機能をフルに使って、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
>>974
一瞬で終わる処理の実行時間を測るには、Subを1000回呼んで時間を1000で割る
0977デフォルトの名無しさん2014/06/27(金) 04:36:07.16ID:fv43ADTP
>>968
シート全選択で、実際にデータ入ってる範囲はどのくらいなんだ?

つか今気づいたんだが、(一旦保存して開き直して)UsedRange見れば良いんじゃないか
09789452014/06/27(金) 04:39:09.43ID:tthd8i7m
>>975
たしかにそれでも出来るけど
それ用のシート作らんとだめだし処理速度的にどうなんだろうか
配列内ソートの方が圧倒的に早いと思うんだけど
数百件程度のソートでは低速といわれてるバブルソートでも使えたけど
数千件のソートで処理速度的に不満が出てきたので効率化できないかなと

>>975 のやり方も含めて検討してみる ありがとう
あとは個人的な興味もありクイックソートも勉強中してみるっス

さて さすがに眠いな そろそろ仮眠タイムなので寝るっす
ではでは
0979デフォルトの名無しさん2014/06/27(金) 05:07:04.04ID:81jca32s
>>977
UsedRangeじゃだめ
最初の質問をよく読め
0980デフォルトの名無しさん2014/06/27(金) 05:17:01.03ID:jgnIvu2A
>>978
VBAには配列の一部分をまとめてコピーする方法がないんで、ワークシートに展開した方が速そうに思えるけどなあ

もしVBAだけで高速にソートするのが目的なら、単純な2次元配列にせずにVariant型の配列にするとか、
データをコピーせずにインデックス経由でアクセスするとか、根本的にデータ構造やアルゴリズムを工夫しないと
0981デフォルトの名無しさん2014/06/27(金) 06:15:06.07ID:MwZdRGeI
>>978
ごめん、実際に試してみたら、単純なForの二重ループの方がワークシートよりずっと速かったわ
20倍ぐらい差があった
0982デフォルトの名無しさん2014/06/27(金) 06:17:38.59ID:MwZdRGeI
>>974 >>968
パラメータ省略ついでに、重そうな関数の呼び出しを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
09839242014/06/27(金) 13:12:34.79ID:tG/H6ykx
>>982
お返事おそくなりました。
たびたび改良ありがとうございました。
完璧に動きました。私の希望通りの動きです。
Findのテクニックも大変勉強になりました。
重ねてお礼申し上げます。
09849702014/06/27(金) 13:25:59.66ID:fo8RbvYe
>>945
お呼びでないかもしれませんが、ジャグ配列のサンプルコード書きました。
こんな事がしたいのではありませんか?

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:TCJgScNN
09869702014/06/27(金) 13:45:07.18ID:fo8RbvYe
すみません、書き忘れてましたが、ジャグ配列内の各要素にアクセスするときには
ary1(100,500)ではなく、ary1(100)(500)のようにしないとダメです。
あと、多分まとめて操作できるのは片方の要素(今回は最初の100の要素の方)だけです。


ところで、どなたかそろそろ次スレお願いします。
09879702014/06/27(金) 13:54:03.22ID:fo8RbvYe
あぁぁぁぁぁぁっっ!!!
サンプルコード内の注釈が間違ってた……orz
ary1もary2もサイズは(500,100)ではなく(100,500)です。
連投すみませんでした。
09889112014/06/27(金) 13:54:16.09ID:e5TZuaT8
>>913
再起動した後やってみたら上手く行った
何度やっても上手く行かなかったのに、原因不明
09899452014/06/27(金) 14:55:39.03ID:tthd8i7m
>>980さん >>984さん ありがとうございます。

>>967でもちょっと書いたけど
>(ソート処理をFunction化したものの 一部なんだけどね)
各プロシージャで使われる共通Functionなんです
なんでIn/Outの配列仕様は変えたくないのです(あっちこち変更しないとだから)

そのごく一部の処理で 元々数百件のデータを扱うもりで書いた処理が
データ量増加で 数千件に肥大してまい処理時間がかかるようになり
その主要因が 件の共通Functionだったのです。

とは言えそもそも 呼び足し元の処理自体もデータ量増加に対応出来てない部分もあるんで
>>980さんの言われるとおり 根本から見直したほうがよさそうです(D/B利用も含めて)

>>984さん
そうゆう手法もありですね今後の参考にさせてもらいます。
0990デフォルトの名無しさん2014/06/27(金) 19:37:16.88ID:51fPEK/Z
0991デフォルトの名無しさん2014/06/28(土) 05:27:46.68ID:UFon7Qh2
0992デフォルトの名無しさん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
>>992
乙です
0994デフォルトの名無しさん2014/06/28(土) 20:46:27.10ID:18/3jPkp
>>992
おつ
0995デフォルトの名無しさん2014/06/28(土) 21:32:22.70ID:S4simBtK
うめ
0996デフォルトの名無しさん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:CYmFK5pL
>>996
EXCELの数式だけで片付きそうなもんだけど、
VBAでやりたい理由が何かあるの?
0998デフォルトの名無しさん2014/06/28(土) 21:47:06.54ID:QPLRDCyX
>>996
ループ if
0999デフォルトの名無しさん2014/06/28(土) 21:53:46.84ID:87/kSllN
>>997
調べてみたらVLOOKUPというものでできそうですね
こういうのはVBAでやるものだと思い込んでました
ありがとうございます
>>998
ありがとうございます
1000デフォルトの名無しさん2014/06/28(土) 21:54:55.58ID:xYrnaOxY
1000なら桃白白と付き合える!
10011001Over 1000Thread
このスレッドは1000を超えました。
もう書けないので、新しいスレッドを立ててくださいです。。。
レス数が1000を超えています。これ以上書き込みはできません。