Excel VBA 質問スレ Part33
レス数が1000を超えています。これ以上書き込みはできません。
0001デフォルトの名無しさん
2013/10/17(木) 22:04:40.64＿＿＿
＿＿＿ ／＿＿＿_ヽ ＿＿__
/＿＿＿_＼ | |´・ω・｀| | ／＿＿＿ヽ
.ｌ |´・ω・｀| ニ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
0903デフォルトの名無しさん
2014/06/25(水) 21:24:19.82ID:IMwLZcWPエラーのセルは数字以外のデータ("NaN")だって前提で良いのか？
Dim lastgoodrow As Long
Dim i As Long
For i = lastrow To 1 Step -1
If IsNumeric(.Cells(i, 1)) Then
lastgoodrow = i
Exit For
End If
Next
こんな感じでいけるんじゃね
Do Loopでもやれなくはないけど
0904900
2014/06/25(水) 21:26:51.14ID:37/MdzoUSub test()
Dim col As Long '処理対象列
Dim rw As Long '最終行
Dim er As String '検索するエラー値
With ThisWorkbook.Sheets(1) '処理対象シートの指定
col = 1 '1列目を指定
er = "NaN" 'エラー値”NaN"を設定
rw = .Cells(.Rows.Count, col).End(xlUp).Row
If .Cells(rw, col).Value = er Then
rw = .Cells(1, col).Resize(rw).Find(What:=er, after:=.Cells(rw, col), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True).Row - 1
End If
End With
End Sub
ただし、使わないと可読性は下がるかもしれない。
0905900
2014/06/25(水) 21:31:27.09ID:37/MdzoU>>893が独自に"NaN"という文字列をエラーとして定義しているだけじゃないの?
エラー以外が数値かどうかもはっきりしないから
それ前提で>>900のコード書いたんだけど。
0906デフォルトの名無しさん
2014/06/25(水) 21:41:08.62ID:5r4HS54BLastGoodRow = -1
If Cells(LastRow,1) <> "NaN" Then
LastGoodRow = LastRow
Else
For i = LastRow To 1 Step -1
If Cells(i, 1) <> "NaN" Then
LastGoodRow = i
Exit For
End If
Next
End If
if LastGoodRow = -1 Then
MsgBox "全部エラーだって、信じらんない"
End If
0907>>899
2014/06/25(水) 21:45:00.34ID:2Yp71LFs>>905のおっしゃる通りNaNというのは私が出力プログラム側で設定したエラーメッセージです。
参考にして下記のコードで試したところうまくいきました。1 step -1という意味が調べても出てきませんが、ウォッチしていくと思い通りの動きをしてくれるのでこれで良いと思います。とても助かりました。
for i = lastrow to 1 step -1
if cells(lastrow,1).value=″NaN″ then lastrow=lastrow-1
else exit for
end if
next i
すべてメモ帳に保存して勉強します。とても参考になりました。
0908デフォルトの名無しさん
2014/06/25(水) 22:14:38.62ID:37/MdzoU1 step -1 っていうふうに区切っちゃ駄目。
あくまでも
For i = A to B step C
という構文の一部だからね。
変数iをカウンターとして、Aがその開始値でBが終了値、
Cは、ループするときの数値の増減を指定するものだよ。
デフォルトは１だからループ一回ごとにカウンターが1ずつ増える。
Stepを-1にすればループするごとにiの値が1ずつ減る。
今回はそれを利用して判定する行をひとつずつ上にずらしてるんだよ。
下から上に1行ずつセルの値が"NaN" かどうかを判定して、
初めて"NaN" じゃなかった行を取得してる。
ちなみに俺の書いたコードではFindを使って上から下に検索し、
初めて”NaN"が出てくる行（の一個上の行）を取得してました。
0909デフォルトの名無しさん
2014/06/25(水) 22:24:54.50ID:WuPundp1>ちなみに俺の書いたコードではFindを使って上から下に検索し、
>初めて”NaN"が出てくる行（の一個上の行）を取得してました。
目的からすると下から上にNaN以外を探した方がベターなんじゃない
0910デフォルトの名無しさん
2014/06/25(水) 22:50:03.47ID:37/MdzoUデータの総数とエラー値の個数がわからないからなんとも言えないんじゃないですか?
データが10万行有って、そのうちつかえるデータが100行ほどで
残りが全部NaNだった、なんて場合は上からのほうが早いですし。
まぁ、そんな極端な事例があるかどうかは知りませんが。
あと、一行ずつループで判定するよりは
ざっくりFindで検索のほうが分かりやすいかなと。
0911デフォルトの名無しさん
2014/06/26(木) 01:42:15.08ID:QF5vpOOe10列目「氏名」のフィルターでオプションを選び
「山田*」と等しい OR 「山本*」と等しい
を選択して実効
記録を見ると
Selection.AutoFilter Field:=10, Criteria1:="=山田*", Operator:=xlOr, Criteria2:="=山本*"
となっている
ここで「山田」「山本」を決め打ちするのではなく入力できるように修正した
例） 名字〜フルネーム 名字先頭2文字
入力1 → 佐藤花子 → 佐藤* → inNAME1
入力2 → 鈴木一郎 → 鈴木* → inNAME2
Selection.AutoFilter Field:=10, Criteria1:=inNAME1, Operator:=xlOr, Criteria2:=inNAME2
これで、氏名の先頭2文字が「佐藤」と「鈴木」のデータが抽出されるはずなんだけど
先に入力した文字、例えば inNAME1＝"佐藤*"のとき、佐藤さんのみが抽出され、鈴木さんが表示されません
因みに
Selection.AutoFilter Field:=10, Criteria1:="佐藤*", Operator:=xlOr, Criteria2:="鈴木*"とマクロに決め打ちすると
両者が表示されました
何が間違っているのでしょう？
0912デフォルトの名無しさん
2014/06/26(木) 05:15:04.25ID:A8fdTDkm最近VBAの勉強を始めたんですけど、自分はプログラミングに向いてない気がしてます。
向き不向き関係なく、忍耐強く続けていればある程度のレベルまでいけるものなんでしょうか？
0913デフォルトの名無しさん
2014/06/26(木) 05:44:43.82ID:YKDhPwk8>何が間違っているのでしょう？
お前のコード。試したけどAutoFilterの所は間違ってない
一旦AutoFilterクリアしてもダメなら、それまでのコードのどこかが間違ってる
0914デフォルトの名無しさん
2014/06/26(木) 10:41:11.02ID:Vl0DMOsH目的によって違うでしょ
趣味で楽しむなら自分が満足できればOK
極端に論外な質問じゃなければ（入門書に書いてある最低限の基本レベルの話しとか、ググればわかる話とか）
解らないことはネットで聞けば誰かが教えてくれるので問題ない
後は実力次第で仕事にできるかも
仕事にしたいというのなら中級レベルくらいまでは自力でこなせるくらいじゃないと難しいだろうね
仕事は人に聞きながらやるものではない
特別にセンスのある人なら、自力で相当なレベルまで行くんだろうけど
1人で勉強していると、参考書やネット検索だけでは行き詰まるときがある
へーそんなことができるんだとか、そんな手があったんだというテクニックとか
職場や学校なら先輩・同僚・友人から知恵を拝借なんだけど、1人では調べても気付かないことがある
そこはネットで質問すればいい
結局あるレベルに到達するまで続けられるかどうかだね
0915デフォルトの名無しさん
2014/06/26(木) 10:46:41.59ID:3UKMa8v3手動でやってることをVBAで単純に自動化するってレベルなら、
知識だけで出来るものなので頑張れば誰でも到達できる
これはプログラムというよりマクロだね
マクロの記録も、手動でやったことをそのまま記録して再現するだけだからそれと同じで
コードを書くと言ってもプログラミングとは呼べない、機械でも出来る単純作業
手動作業の自動化でも、単純に手動操作と同じ手順を踏んでいくのではなく
効率的に処理するためのアルゴリズムを考え出したり、効率的な操作や入力のための
インターフェイルを作ったりって部分は、知識も必要だがそれ以上に
根本的な頭の回転の良さや、理論的思考能力、プログラミングセンスなどが関わってくるので
程度問題ではあるが、努力だけで誰でも出来るというものではない
0916デフォルトの名無しさん
2014/06/26(木) 10:48:05.80ID:Sh8OHuSQVBAの中から、外部にあるSWI-Prologの定義述語を質問として呼び出してその解を得る方法を教えてください。
0917デフォルトの名無しさん
2014/06/26(木) 19:36:02.44ID:/K4PsCsscopyの前にactivateを挟んだり、copyのdestinationを使うのをやめてpasteを使ったりすればしのげることがほとんどなんですが、これはどうしてこんなことが起きるのでしょうか
0918デフォルトの名無しさん
2014/06/26(木) 20:39:07.57ID:GQSdjYychttp://okwave.jp/qa/q1837160.html
これの回答通りにしても、全角文字が化けます。
質問者はこの回答をヒントにして対応できたと書いていますが、
具体的にどう対応したのかどなたかわかりませんか？
0919デフォルトの名無しさん
2014/06/26(木) 20:49:22.99ID:opxnlqAwそのAPIは使った事ないから具体的なアドバイスが出来ないけど
ここあたりが参考にならない？
http://www.happy2-island.com/access/gogo03/capter90301.shtml
0920デフォルトの名無しさん
2014/06/26(木) 20:54:38.15ID:NJwGBRS/めんどいからftpコマンド使えば？
0922デフォルトの名無しさん
2014/06/26(木) 21:37:25.60ID:opxnlqAwなんか 全角文字が シフトJIS でない気もするんだけど
ダウンロード元のファイルは 全角文字 シフトJISなの？
＞msdosでやると全角がばけないんです。
良くわからんがどういう事？
0923918
2014/06/26(木) 22:07:42.74ID:GQSdjYycmsdosでFTPコマンドを対話式で実行すると文字化けしないという意味です。
その際、私の場合は、getの前にqoute type c 943を実行しています。
0924デフォルトの名無しさん
2014/06/26(木) 22:13:14.65ID:jelhdoL6┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬
１│ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │
├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼
２│ │●│●│●│ │ │ │ │ │ │ │ │ │ │ │ │
├─┼─┼─┼─┼─┼─┏━━━━━━━━━━━┓─┼─┼─┼─┼
３│ │●│●│●│ │ ┃ │ │ │ │ │ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┃─・─┼─┼─┼─・─┃─┼─┼─┼─┼
４│ │ │●│●│ │ ┃ │ │●│●│ │ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
５│ │ │ │ │ │ ┃ │●│ │●│ │ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
６│ │ │ │ │ │ ┃ │●│ │●│ │ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
７│ │ │ │ │ │ ┃ │●│ │●│●│ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┃─・─┼─┼─┼─・─┃─┼─┼─┼─┼
８│ │ │ │ │ │ ┃ │ │ │ │ │ ┃ │ │ │ │
├─┼─┼─┼─┼─┼─┗━━━━━━━━━━━┛─┼─┼─┼─┼
データがいくつかの領域に分れている時に（この例では二か所に分布）、その中で
ある一つのデータ領域を囲むように選択したとして（太い罫線）、その状態で
囲まれているデータの実質のデータ領域を取り出したいのですがどんな方法がありますか？
この例では Ｈ４：Ｋ７ というアドレスを取得したいのです。
0925デフォルトの名無しさん
2014/06/26(木) 22:19:02.60ID:4VblDczs0926デフォルトの名無しさん
2014/06/26(木) 22:47:54.48ID:kbxRbX970927デフォルトの名無しさん
2014/06/26(木) 22:55:41.37ID:kbxRbX97上下左右4方向にSelection.Find("●")
0928デフォルトの名無しさん
2014/06/26(木) 23:10:07.56ID:YKDhPwk8FTPにはバイナリモードとテキスト（アスキー）モードがあるのはわかってる？
その例は見る限り、バイナリモードで転送するようにして文字コード変換させない事にしてる
お前が化けないっていってるときは、TYPEコマンド送出してるって事はおそらくアスキーモード
wininet.dllがどうなってるか知らんが、同じようにTYPEコマンド送ってアスキーで転送すれば行けるんじゃね
それでだめならサーバ側でログ調査
これ以上はVBAまったく関係ないからどっか適切なとこで聞いてください
0929デフォルトの名無しさん
2014/06/26(木) 23:21:02.14ID:wyn/j17F線分の両端は各セルの真ん中になります。
0930デフォルトの名無しさん
2014/06/26(木) 23:36:54.58ID:kbxRbX97セルの中心座標は
With Range("A1")
x1 = .Left + .Width / 2
y1 = .Top + .Height / 2
End With
線を引くのは
ActiveSheet.Shapes.AddLine x1, y1, x2, y2
0931デフォルトの名無しさん
2014/06/26(木) 23:39:13.96ID:jelhdoL6>>925,926
その場合、各セルにデータが有るかどうか一個ずつ順番に調べていくとすると
効率が悪いと思うのですが、でもそれしか方法は無いでしょうか?
>>927
確かにデータが●だけならその方法が良いかも知れませんが、●以外の一般の
データの場合で考えています。
0932デフォルトの名無しさん
2014/06/26(木) 23:46:01.80ID:wyn/j17Fよっしゃ。
0933デフォルトの名無しさん
2014/06/26(木) 23:47:56.49ID:kbxRbX97Find("*")
0934912
2014/06/26(木) 23:48:36.11ID:A8fdTDkm>>915
当たり前ですが、やはりある程度以上になるとセンスが必要になってくるんですね。
とりあえずどこかしら楽しめる範囲で続けていこうと思います。
ありがとうございました。
0935デフォルトの名無しさん
2014/06/26(木) 23:49:07.94ID:t2BI4rIw要求仕様がイマイチ不明確なんだけど、要するに
選択された矩形範囲内で外縁部の空白セルを含まない
CurrentRejion領域を求めればいいんだよな？
（最初の質問に有った「データがいくつかの領域に分れている時に」は関係ないよね？）
Currentrejion に CountIf の組み合わせで出来そうな気がするんだけど、
実際にコードで書くとなるとイマイチ考えがまとまらない。
0936デフォルトの名無しさん
2014/06/26(木) 23:49:38.72ID:wyn/j17F0937デフォルトの名無しさん
2014/06/26(木) 23:50:20.41ID:3UKMa8v3CurrentRegion
0938935
2014/06/26(木) 23:55:18.56ID:t2BI4rIw0939デフォルトの名無しさん
2014/06/26(木) 23:59:25.82ID:jelhdoL6>>「データがいくつかの領域に分れている時に」は関係ないよね？
その通りです。説明が悪くてすみません。
出来れば参考になるコード、よろしくお願いします。
0940デフォルトの名無しさん
2014/06/27(金) 00:07:15.61ID:MwZdRGeI□□□□□
□□□■□
□□□□□
□■■□□
□□□□□
0941デフォルトの名無しさん
2014/06/27(金) 00:07:42.04ID:MwZdRGeI質問はもっと丁寧に
何の色？
0942デフォルトの名無しさん
2014/06/27(金) 00:18:06.71ID:fv43ADTPDim startcell As Range, endcell As Range
Dim lineshape As Shape
Set startcell = Sheet1.Range("B2")
Set endcell = Sheet1.Range("D3")
Set lineshape = Sheet1.Shapes.AddLine( _
startcell.Left + startcell.Width / 2, _
startcell.Top + startcell.Height / 2, _
endcell.Left + endcell.Width / 2, _
endcell.Top + endcell.Height / 2)
lineshape.line.ForeColor.RGB = vbBlack
もう来るなよ
0943デフォルトの名無しさん
2014/06/27(金) 00:21:57.37ID:tG/H6ykxその場合は
□□■
□□□
■■□
の部分を取り出したいです。
0944デフォルトの名無しさん
2014/06/27(金) 00:23:10.49ID:aWx7sjWc0945デフォルトの名無しさん
2014/06/27(金) 00:47:50.48ID:tthd8i7m2重ループにしないで(For j=･････なしに)配列を一発で
代入できないでしょうか？
k=0
For i = LBound(Arry1, 1) To UBound(Arry1, 1)
if とある条件 then
k=k+1
For j = LBound(Arry1, 2) To UBound(Arry1, 2)
Arry2(k, j) = Arry1(i, j)
Next
end if
Next
0946デフォルトの名無しさん
2014/06/27(金) 00:49:58.75ID:MwZdRGeIその「愚直に調べる」方法にも色々あるだろ
0947デフォルトの名無しさん
2014/06/27(金) 00:53:49.28ID:fv43ADTP素直にコード書いてくださいって言えよ
0948デフォルトの名無しさん
2014/06/27(金) 00:54:47.16ID:MwZdRGeI無理
処理スピード関係なくコードをシンプルにしたいだけなら、ワークシートにデータを置くという方法がある
ワークシート上なら簡単に不要な列を詰めたりできる
あるいは、行ごとにJoinして一次元配列にしといて、処理が終わったら最後にSplitで2次元に戻すとか
0949デフォルトの名無しさん
2014/06/27(金) 00:56:56.44ID:MwZdRGeI日付変わってID変わったけど俺は>>927 >>933だよ
Findを4回よりシンプルな方法ってあるか？
0950デフォルトの名無しさん
2014/06/27(金) 00:59:53.62ID:aWx7sjWc0951945
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
オーバーフローしました。
もし解決方法が有りましたら教えてください。
シート全選択時でも１秒以内くらいが理想です。
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:xYrnaOxY1001１００１
Over 1000Threadもう書けないので、新しいスレッドを立ててくださいです。。。
レス数が1000を超えています。これ以上書き込みはできません。