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

Excel VBA 質問スレ Part33

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

　　　　　　　　　　　　　　　　　　 ＿＿＿
　　　　　　　＿＿＿　　　　　 ／＿＿＿_ヽ　　　　 　＿＿__
　　　　　　/＿＿＿_＼　　　 |　|´・ω・｀|　| 　　　／＿＿＿ヽ
　　　　　 .ｌ |´・ω・｀|　 ニ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
0868デフォルトの名無しさん2014/06/23(月) 16:22:31.21ID:h9OdHO6e
そんな手間かけるより使う人達にEnter連打するなって言えば済む話じゃないか？
0869デフォルトの名無しさん2014/06/23(月) 16:26:14.54ID:LmsmhY4T
そんなもんで連打しなくなるなら、ワンクリ詐欺とか激減するわけで...
0870デフォルトの名無しさん2014/06/23(月) 16:39:51.77ID:h9OdHO6e
そのメッセージボックスがいかなる状態で表示されるのか不明だけれど、
メッセージ表示のトリガーをマウス操作にすれば
（画面上の何らかのオブジェクトをマウスでクリックした後でメッセージが表示されるようにする）
Enter連打は回避できる
0871デフォルトの名無しさん2014/06/23(月) 17:33:26.97ID:ERNDPjz2
教えてください

　　A　　B　　　　C　　D
1山田　ﾊﾟﾝﾂ　100　
2(空白行)
3田中　ﾊﾟﾝﾂ 100
4　　　　ｽﾃﾃｺ　300
5(空白行)
6伊藤　ﾊﾟﾝﾂ　100
7　　　　ｼｬﾂ　　200
8　　　　靴下　400
9(空白行)

このように一人一人が購入した品物と金額が入った表を別のCSVファイルから取り込むﾏｸﾛを作ってます
取り込みや体裁を整えるところは出来たのですが、わからないことがあるので教えてください。

D列に各顧客の合計金額を出したいのですが、顧客ごとの行数がまちまちなので範囲の指定方法がわかりません。
幸い顧客と顧客の間には必ず空白行が入るので空白行を目安に範囲指定すれば良さそうとは思うのですが方法がわからないです。
合計は名前のある行のD列に入れたいと考えてます。

不特定なの範囲での合計はどのように書けばできるのでしょうか？
0872デフォルトの名無しさん2014/06/23(月) 17:44:48.00ID:XnygHaO/
>>871
Endプロパティとか、ループでB列の空白を判定とかでいいんじゃね？

でもさ、そういう不適切な集計の仕方はやめた方がいいよ
集計が面倒になる原因って、難しいことをやってるからとかではなく
元データの形式や集計結果の出し方が不適切故に、
不適切なことを一発でやるための機能が備わってないから、
遠回りが必要になってるだけで、正しくやれば
ものすごく簡単に同じ結果を出せるんだからさ
0873デフォルトの名無しさん2014/06/23(月) 19:10:58.16ID:3o7GTMgO
>>867
https://friendpaste.com/6Efa456sVeLQgRAfYxFAHV
考えてみた
こんなんでいいんじゃないのか
0874デフォルトの名無しさん2014/06/23(月) 21:27:39.48ID:h9OdHO6e
>>871
まぁ、本来は>>872さんの仰る通りなんだけど、
コード書いてみたかったから書きました。

A列に名前がある行を先頭にして、B列で空白が出てきた行までの範囲の
C列の値を集計して、先頭行のD列に書き込むマクロです。
処理対象シートの下の方から順次処理をして、先頭行のD列が空白ではない時点、
もしくは先頭行が1行目になった時点で処理を終了します。

なお、With 〜　のところで処理するシートを指定しているので、
使用する際はここを適宜書き換えてください。

Sub test()
Dim rwA As Long
Dim rwB As Long
With ThisWorkbook.Sheets(1)
rwA = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(rwA, 1) = "" Then Exit Sub
rwB = .Cells(rwA, 2).End(xlDown).Row
Do
If .Cells(rwA, 4) = "" Then Exit Do
.Cells(rwA, 4) = WorksheetFunction.Sum(.Cells(rwA, 3).Resize(rwB - rwA + 1))
If rwA = 1 Then Exit Do
rwB = .Cells(rwA - 1, 2).End(xlUp).Row
rwA = .Cells(rwA, 1).End(xlUp).Row
Loop
End With
End Sub
0875桃白白 ◆9Jro6YFwm650 2014/06/23(月) 21:32:42.29ID:WlySWkx4
　　　∩＿＿＿∩
　　　| 丿　　　　　ヽ
　　 /　　●　　　● |
　　 |　　　　( _●_) 　ミ
　 彡､　　　　ヽノ　,,/ 　　　♪
　 / 　　　　┌─┐´
　|´　 丶　ヽ{ .茶 }ヽ
　 ｒ　 　 ヽ、__)ニ(_丿
　ヽ、___　　　ヽ　ヽ
　　と＿＿_＿ノ＿ノ
08768742014/06/23(月) 21:44:44.46ID:h9OdHO6e
あれ？
書き間違えてた。

If .Cells(rwA, 4) = "" Then Exit Do

じゃなくて

If .Cells(rwA, 4) <> "" Then Exit Do

です。
何で間違えたんだろ?
（多分、3行上からIf文をコピペして "=" を "<>" に直し忘れたんですね）
あと、表の開始行が1行目じゃないとエラーが出ますので、
その場合は

If rwA = 1 Then Exit Do

の1を開始する行に変更してください。
0877デフォルトの名無しさん2014/06/23(月) 21:47:48.46ID:eOLFLVwW
面談
「オブジェクト指向できる？」
「C#できる？」
「UMLかける？」

そして入ってみたらVBAの案件やった
なんでやねん
0878桃白白 ◆9Jro6YFwm650 2014/06/23(月) 21:54:21.02ID:WlySWkx4
>>877
超いいじゃん、うらやましい
0879デフォルトの名無しさん2014/06/23(月) 23:02:37.78ID:ZccyYMgG
>>877
あなたが全部できないから仕方なく？
0880デフォルトの名無しさん2014/06/23(月) 23:36:38.89ID:c5Kifoi8
818です。
メッセージボックスで白熱の議論になってしまい
ちょっとビックリしています

>>870
バーコードリーダーでバーコードを読んだ時に
それが過去に入力済みのバーコードだった場合に
「上書きしますか」とメッセージボックスが表示されるようになっています。
バーコードで読んだ管理番号を元に対象の行を一覧表から検索し、
入力者、入力日などの情報を追記・更新するプログラムになります。

トリガーはWorksheet_Changeイベントです。
机に沢山のバーコードラベルを並べて、連続で読んでいく入力方法を考えていて、
正確に言うと問題なのはENTER連打ではなくバーコード連続入力です。
バーコードを読んだとき最後にENTERキーが押されたのと同じ効果が発生するので、
メッセージボックス表示中に、次のバーコードを読んでしまった場合に
メッセージが飛ばされ、入力者が気づかない恐れがあると言った具合です。
0881デフォルトの名無しさん2014/06/23(月) 23:44:37.17ID:qAGmjPdg
>>880
>>873
ためせば
シートロックするからバーコードのキー入力も受け付けないんじゃね
08828702014/06/23(月) 23:54:40.63ID:h9OdHO6e
>>880
あぁ、そういうことですか。
作業中にEnter連打とか
どんなバカ野郎揃いの職場なんだと思ってました、ゴメンなさい。

そんじゃあ、Yes/Noじゃなくて、Yes/No/キャンセルの3つのボタンを用意して、
デフォルトをキャンセルボタンにしておいたらどうですか？

で、キャンセル選択時には再びメッセージボックスを表示するように無限ループにしておく。

あるいはメッセージボックス表示前とボタン押下後にNowで時刻を取得して
1秒以上（別に1秒じゃなくてもいいけど）経過してなければ
同様に無限ループとか。

閾値が1秒だとちょっと作業のテンポが悪すぎかもしれないんですが、
確かミリ秒単位で時間を計れるマクロがググッたらどっかに在った気がします。
0883デフォルトの名無しさん2014/06/24(火) 00:09:38.96ID:p/P3a7R3
>>881
>>882
回答ありがとうございます。

ますは、882のデフォルトをキャンセルにする方法で対応して、
ゆくゆくは873の方を導入したいと思います。
知らない機能を使ってるみたいなので少し勉強が必要そうです。
0884デフォルトの名無しさん2014/06/24(火) 00:26:03.63ID:Ti0c9rze
Yes/No/キャンセルとかじゃなくて、デフォルトNOのYes/Noだけで良い気がするが
0885デフォルトの名無しさん2014/06/24(火) 00:26:49.78ID:F5DFjMP3
Noとかキャンセル押してもダイアログが閉じないって悪夢だけどな
0886デフォルトの名無しさん2014/06/24(火) 00:50:31.53ID:5iFc+8Q+
>>884
Yes/Noだけだと、2つのうち1つはEnter連打を無視するのに使わなきゃならないから
本来やりたいデータの上書き確認が出来ないってことなんじゃないの？
0887デフォルトの名無しさん2014/06/24(火) 01:27:24.29ID:yc/rKAcg
>>885
悪質サイトにありがちな、入会しますか？ で、どうあがいても Yes しか押せないみたいな w
0888デフォルトの名無しさん2014/06/24(火) 04:24:16.40ID:Ti0c9rze
ああ、Yes/Noがもともと必要なのか

上書きしますか?（はい／いいえ）
いいえ->上書きしませんか?（はい／いいえ）
いいえ->上書きしますか?（はい／いいえ）
いいえ->上書きしませんか?（はい／いいえ）
以下永久にループでｗ
0889デフォルトの名無しさん2014/06/24(火) 05:31:01.64ID:kCZG54Z4
そもそも・・・
0890デフォルトの名無しさん2014/06/24(火) 08:43:47.68ID:zV5ogSbP
　＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿_
　|Windows　　　　　　　　　　　　　　 　 　　 　 　 　 [−][口][×]|
　|￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣|
　|　　ﾊ,,ﾊ　　　　　　　　　　　　　　　　　 　 　 　 　 　 　 　 　 　 |
　|　（ ﾟωﾟ）　　お断りしますが、よろしいですか?　　　　　　　 ｜
　|　───　　　　　　　　　　　　　　　　　　　　　　　　　　　　　｜
　|　　　 ＿＿＿＿＿＿　 ＿＿＿＿＿＿ 　 ＿＿＿＿＿＿ 　 |
　| 　 　｜　はい（Y）　｜｜　はい（Y）　 ｜｜　 はい（Y）　|　 |
　|　　　 ￣￣￣￣￣￣ 　 ￣￣￣￣￣￣ 　￣￣￣￣￣￣ 　 |　
　 ￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣
0891デフォルトの名無しさん2014/06/24(火) 09:21:49.91ID:oDNeDxJ6
>>887
アメーバ会員の退会手順がそうだった
なんども退会しますか？ほんとうに退会しますか？って無限ループω
0892デフォルトの名無しさん2014/06/24(火) 10:43:03.21ID:jPo8ZSVb
>>874
サンプルｺｰﾄﾞありがとうございました。
こういうやり方があるの勉強になりました
0893デフォルトの名無しさん2014/06/25(水) 19:54:49.36ID:BILL5zsz
行ごとに羅列されたデータの最終行を取得するマクロを組みたいのですが、最後の方になるとエラーを含むことがあります。エラーが起きる直前の最終行の値を拾いたいのですが、どうすればよいのでしょうか。

エラーとなる言葉はNaNという言葉になり、ある行からNaNになれば以降はずっとNaNになるため、NaNの直前の行を取得できれば良いです。

もともと最終行は
.cells(rows.count,1).end(xlup).row
.cells(1,columns).end(xltoleft).column
で取得しています。
よろしくお願いします。
0894デフォルトの名無しさん2014/06/25(水) 20:17:48.86ID:vwnOk3e3
>>893
SpecialCellsを使えばいいんじゃないかと
＞指定された条件を満たしているすべてのセル (Range オブジェクト) を返します。
なので

Set Err_Cell = Range("A1:A100").SpecialCells(xlCellTypeFormulas, xlErrors)
Set Before = Err_Cell.Cells(1, 1).Offset(-1)

とかとか
0895デフォルトの名無しさん2014/06/25(水) 20:39:19.00ID:5r4HS54B
>>893
>.cells(rows.count,1).end(xlup).row
>.cells(1,columns).end(xltoleft).column

みつかったセルから1行目まで順繰りに調べて行けばいいだけ
0896デフォルトの名無しさん2014/06/25(水) 20:40:07.79ID:IVQPbhSw
>>894
ありがとうございます。
試してみます。
もうひとつ質問なのですが、列のうちある値を超えた時の最小の行番地をかえしてほしいとき、
min(if(a1:a100)>x,rows(a1:a100)とやったらうまくいきません。どうすればよいのでしょうか。前で来たのですがうろ覚えなせいかできません。
08978942014/06/25(水) 20:40:17.63ID:vwnOk3e3
あゴメン　Excelに　NaNっていうエラー値なかった
エラーって言葉で勘違いしてた
>>894は無視して
0898デフォルトの名無しさん2014/06/25(水) 20:41:09.47ID:IVQPbhSw
>>896
すみません、うまくいきました
0899デフォルトの名無しさん2014/06/25(水) 21:00:15.35ID:LGqGwfyW
>>895
しらべるというのは最終行を取得したあと
繰り返して調べてもし値があれば更新していくと考えて、
do isnumeric(cells(lastrow,1)=false then
lastrow=lastrow-1
elseif exit
loop
とすればよいのでしょうか？いまいちよく分からないです
0900デフォルトの名無しさん2014/06/25(水) 21:15:40.33ID:37/MdzoU
>>893
コード書いてみた
以下のマクロを実行すると変数colで指定した列の最終行が変数rwに入る
例によってシートはWith〜で指定しているので適宜書き換えてください。

Sub test()
Dim col As Long　　　'処理対象列
Dim rw As Long　　　'最終行
Dim er As String　　'検索するエラー値
Dim rng As Range
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
　　Set rng = .Cells(1, col).Resize(rw).Find(What:=er, after:=.Cells(rw, col), _
　　LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
　　SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True)
　　rw = rng.Row - 1
　End If
　Set rng = Nothing
End With
End Sub
0901デフォルトの名無しさん2014/06/25(水) 21:19:26.53ID:5r4HS54B
>>899

for 探索行 = 見つかった行 to 1 step -1
if 数値かどうか and エラーでは無い とか then
目的の行 = 探索行
exit for
endif
next
0902デフォルトの名無しさん2014/06/25(水) 21:24:00.62ID:5r4HS54B
エラーが全く無いとか、エラーが2回以上続くとか、そういうのに対応するなら工夫がいる
エラーならフラグをたてて、エラーじゃなくなるまで探せばいい
0903デフォルトの名無しさん2014/06/25(水) 21:24:19.82ID:IMwLZcWP
>>899
エラーのセルは数字以外のデータ("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でもやれなくはないけど
09049002014/06/25(水) 21:26:51.14ID:37/MdzoU
>>900はRange変数を使わなくても問題なかった。

Sub 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

ただし、使わないと可読性は下がるかもしれない。
09059002014/06/25(水) 21:31:27.09ID:37/MdzoU
エクセルが吐く本来のエラーじゃなくて、
>>893が独自に"NaN"という文字列をエラーとして定義しているだけじゃないの?
エラー以外が数値かどうかもはっきりしないから
それ前提で>>900のコード書いたんだけど。
0906デフォルトの名無しさん2014/06/25(水) 21:41:08.62ID:5r4HS54B
良く読んでなかった、こうだな

LastGoodRow = -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>>8992014/06/25(水) 21:45:00.34ID:2Yp71LFs
>>901,>>902,>>903,>>904,>>905,>>906ありがとうございます。
>>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/MdzoU
>>907
1 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
>>908
>ちなみに俺の書いたコードではFindを使って上から下に検索し、
>初めて”NaN"が出てくる行（の一個上の行）を取得してました。

目的からすると下から上にNaN以外を探した方がベターなんじゃない
0910デフォルトの名無しさん2014/06/25(水) 22:50:03.47ID:37/MdzoU
>>909
データの総数とエラー値の個数がわからないからなんとも言えないんじゃないですか?
データが10万行有って、そのうちつかえるデータが100行ほどで
残りが全部NaNだった、なんて場合は上からのほうが早いですし。
まぁ、そんな極端な事例があるかどうかは知りませんが。

あと、一行ずつループで判定するよりは
ざっくりFindで検索のほうが分かりやすいかなと。
0911デフォルトの名無しさん2014/06/26(木) 01:42:15.08ID:QF5vpOOe
フィルターを設定したシートを使い手動でマクロを記録した

10列目「氏名」のフィルターでオプションを選び
「山田*」と等しい　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
>>911
>何が間違っているのでしょう？
お前のコード。試したけどAutoFilterの所は間違ってない
一旦AutoFilterクリアしてもダメなら、それまでのコードのどこかが間違ってる
0914デフォルトの名無しさん2014/06/26(木) 10:41:11.02ID:Vl0DMOsH
>>912
目的によって違うでしょ

趣味で楽しむなら自分が満足できればOK
極端に論外な質問じゃなければ（入門書に書いてある最低限の基本レベルの話しとか、ググればわかる話とか）
解らないことはネットで聞けば誰かが教えてくれるので問題ない
後は実力次第で仕事にできるかも

仕事にしたいというのなら中級レベルくらいまでは自力でこなせるくらいじゃないと難しいだろうね
仕事は人に聞きながらやるものではない
特別にセンスのある人なら、自力で相当なレベルまで行くんだろうけど
1人で勉強していると、参考書やネット検索だけでは行き詰まるときがある
へーそんなことができるんだとか、そんな手があったんだというテクニックとか
職場や学校なら先輩・同僚・友人から知恵を拝借なんだけど、1人では調べても気付かないことがある
そこはネットで質問すればいい

結局あるレベルに到達するまで続けられるかどうかだね
0915デフォルトの名無しさん2014/06/26(木) 10:46:41.59ID:3UKMa8v3
>>912
手動でやってることをVBAで単純に自動化するってレベルなら、
知識だけで出来るものなので頑張れば誰でも到達できる
これはプログラムというよりマクロだね
マクロの記録も、手動でやったことをそのまま記録して再現するだけだからそれと同じで
コードを書くと言ってもプログラミングとは呼べない、機械でも出来る単純作業

手動作業の自動化でも、単純に手動操作と同じ手順を踏んでいくのではなく
効率的に処理するためのアルゴリズムを考え出したり、効率的な操作や入力のための
インターフェイルを作ったりって部分は、知識も必要だがそれ以上に
根本的な頭の回転の良さや、理論的思考能力、プログラミングセンスなどが関わってくるので
程度問題ではあるが、努力だけで誰でも出来るというものではない
0916デフォルトの名無しさん2014/06/26(木) 10:48:05.80ID:Sh8OHuSQ
すみません。
VBAの中から、外部にあるSWI-Prologの定義述語を質問として呼び出してその解を得る方法を教えてください。
0917デフォルトの名無しさん2014/06/26(木) 19:36:02.44ID:/K4PsCss
copyメソッドを使うときちょくちょくアプリケーションかオブジェクトエラー1004が出ます
copyの前にactivateを挟んだり、copyのdestinationを使うのをやめてpasteを使ったりすればしのげることがほとんどなんですが、これはどうしてこんなことが起きるのでしょうか
0918デフォルトの名無しさん2014/06/26(木) 20:39:07.57ID:GQSdjYyc
wininet.dllを利用したftpについて教えてください。

http://okwave.jp/qa/q1837160.html


これの回答通りにしても、全角文字が化けます。
質問者はこの回答をヒントにして対応できたと書いていますが、
具体的にどう対応したのかどなたかわかりませんか？
0919デフォルトの名無しさん2014/06/26(木) 20:49:22.99ID:opxnlqAw
>>918
そのAPIは使った事ないから具体的なアドバイスが出来ないけど
ここあたりが参考にならない？
http://www.happy2-island.com/access/gogo03/capter90301.shtml
0920デフォルトの名無しさん2014/06/26(木) 20:54:38.15ID:NJwGBRS/
>>918
めんどいからftpコマンド使えば？
09219182014/06/26(木) 21:14:45.72ID:GQSdjYyc
>>919
そのサイトをもとにしました。
msdosでやると全角がばけないんです。
0922デフォルトの名無しさん2014/06/26(木) 21:37:25.60ID:opxnlqAw
ダウンロードしたファイルをメモ帳で読み込んでもバケてる？
なんか 全角文字が シフトJIS でない気もするんだけど

ダウンロード元のファイルは 全角文字 シフトJISなの？

＞msdosでやると全角がばけないんです。
良くわからんがどういう事？
09239182014/06/26(木) 22:07:42.74ID:GQSdjYyc
>>922
msdosでFTPコマンドを対話式で実行すると文字化けしないという意味です。
その際、私の場合は、getの前にqoute type c 943を実行しています。
0924デフォルトの名無しさん2014/06/26(木) 22:13:14.65ID:jelhdoL6
　　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ　Ｎ　Ｏ　Ｐ　
　┌─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬
１│　│　│　│　│　│　│　│　│　│　│　│　│　│　│　│　│
　├─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼
２│　│●│●│●│　│　│　│　│　│　│　│　│　│　│　│　│
　├─┼─┼─┼─┼─┼─┏━━━━━━━━━━━┓─┼─┼─┼─┼
３│　│●│●│●│　│　┃　│　│　│　│　│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┃─・─┼─┼─┼─・─┃─┼─┼─┼─┼
４│　│　│●│●│　│　┃　│　│●│●│　│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
５│　│　│　│　│　│　┃　│●│　│●│　│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
６│　│　│　│　│　│　┃　│●│　│●│　│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼─┼─┃─┼─┼─┼─┼
７│　│　│　│　│　│　┃　│●│　│●│●│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┃─・─┼─┼─┼─・─┃─┼─┼─┼─┼
８│　│　│　│　│　│　┃　│　│　│　│　│　┃　│　│　│　│
　├─┼─┼─┼─┼─┼─┗━━━━━━━━━━━┛─┼─┼─┼─┼

データがいくつかの領域に分れている時に（この例では二か所に分布）、その中で
ある一つのデータ領域を囲むように選択したとして（太い罫線）、その状態で
囲まれているデータの実質のデータ領域を取り出したいのですがどんな方法がありますか？
この例では　Ｈ４：Ｋ７　というアドレスを取得したいのです。
0925デフォルトの名無しさん2014/06/26(木) 22:19:02.60ID:4VblDczs
愚直に調べるしかないんじゃないの
0926デフォルトの名無しさん2014/06/26(木) 22:47:54.48ID:kbxRbX97
だな
0927デフォルトの名無しさん2014/06/26(木) 22:55:41.37ID:kbxRbX97
>>924
上下左右4方向にSelection.Find("●")
0928デフォルトの名無しさん2014/06/26(木) 23:10:07.56ID:YKDhPwk8
>>918
FTPにはバイナリモードとテキスト（アスキー）モードがあるのはわかってる？
その例は見る限り、バイナリモードで転送するようにして文字コード変換させない事にしてる
お前が化けないっていってるときは、TYPEコマンド送出してるって事はおそらくアスキーモード
wininet.dllがどうなってるか知らんが、同じようにTYPEコマンド送ってアスキーで転送すれば行けるんじゃね

それでだめならサーバ側でログ調査
これ以上はVBAまったく関係ないからどっか適切なとこで聞いてください
0929デフォルトの名無しさん2014/06/26(木) 23:21:02.14ID:wyn/j17F
セルAからセルBまで、直線を挿入したいんですがVBAでどうしますか？
線分の両端は各セルの真ん中になります。
0930デフォルトの名無しさん2014/06/26(木) 23:36:54.58ID:kbxRbX97
>>929
セルの中心座標は
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
>>930
よっしゃ。
0933デフォルトの名無しさん2014/06/26(木) 23:47:56.49ID:kbxRbX97
>>931
Find("*")
09349122014/06/26(木) 23:48:36.11ID:A8fdTDkm
>>914
>>915
当たり前ですが、やはりある程度以上になるとセンスが必要になってくるんですね。
とりあえずどこかしら楽しめる範囲で続けていこうと思います。
ありがとうございました。
0935デフォルトの名無しさん2014/06/26(木) 23:49:07.94ID:t2BI4rIw
>>931
要求仕様がイマイチ不明確なんだけど、要するに
選択された矩形範囲内で外縁部の空白セルを含まない
CurrentRejion領域を求めればいいんだよな？
（最初の質問に有った「データがいくつかの領域に分れている時に」は関係ないよね？）

Currentrejion に CountIf の組み合わせで出来そうな気がするんだけど、
実際にコードで書くとなるとイマイチ考えがまとまらない。
0936デフォルトの名無しさん2014/06/26(木) 23:49:38.72ID:wyn/j17F
線の色を黒くするには？
0937デフォルトの名無しさん2014/06/26(木) 23:50:20.41ID:3UKMa8v3
>>924
CurrentRegion
09389352014/06/26(木) 23:55:18.56ID:t2BI4rIw
あ、俺スペル間違えてるね。ゴメン
0939デフォルトの名無しさん2014/06/26(木) 23:59:25.82ID:jelhdoL6
>>935
>>「データがいくつかの領域に分れている時に」は関係ないよね？
その通りです。説明が悪くてすみません。
出来れば参考になるコード、よろしくお願いします。
0940デフォルトの名無しさん2014/06/27(金) 00:07:15.61ID:MwZdRGeI
CurrentRegionだけだと、選択範囲の中に固まりが2つあった時に対応できないけど、こんなケースは考慮しなくていいの？

□□□□□
□□□■□
□□□□□
□■■□□
□□□□□
0941デフォルトの名無しさん2014/06/27(金) 00:07:42.04ID:MwZdRGeI
>>936
質問はもっと丁寧に
何の色？
0942デフォルトの名無しさん2014/06/27(金) 00:18:06.71ID:fv43ADTP
>>936

Dim 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
>>940
その場合は
□□■
□□□
■■□
の部分を取り出したいです。
0944デフォルトの名無しさん2014/06/27(金) 00:23:10.49ID:aWx7sjWc
愚直に調べるしかなかろうて
0945デフォルトの名無しさん2014/06/27(金) 00:47:50.48ID:tthd8i7m
配列の操作に関して教えてほしいんですが
2重ループにしないで(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
>>944
その「愚直に調べる」方法にも色々あるだろ
0947デフォルトの名無しさん2014/06/27(金) 00:53:49.28ID:fv43ADTP
>>946
素直にコード書いてくださいって言えよ
0948デフォルトの名無しさん2014/06/27(金) 00:54:47.16ID:MwZdRGeI
>>945
無理

処理スピード関係なくコードをシンプルにしたいだけなら、ワークシートにデータを置くという方法がある
ワークシート上なら簡単に不要な列を詰めたりできる

あるいは、行ごとにJoinして一次元配列にしといて、処理が終わったら最後にSplitで2次元に戻すとか
0949デフォルトの名無しさん2014/06/27(金) 00:56:56.44ID:MwZdRGeI
>>947
日付変わってID変わったけど俺は>>927 >>933だよ
Findを4回よりシンプルな方法ってあるか？
0950デフォルトの名無しさん2014/06/27(金) 00:59:53.62ID:aWx7sjWc
シンプルさとか求めてないから
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.　ソート処理本体を バブルソート から クイックソート に変えようとアルゴリズム勉強中です(^^
レス数が950を超えています。1000を超えると書き込みができなくなります。