2015年10月13日

蟻地獄

DSC_0067.JPG
そーいう名前の折り方なんです。これは360枚。
posted by ちょびちょび at 21:53| Comment(101) | TrackBack(0) | 日記
この記事へのコメント
余裕のない年度末を過ごしておりました。年度末はどこの職場でも通常より忙しいとは思いますが、今回の原因は何がなんでも年度内にリリースしたいという担当者の都合で、それなら前々から対策を取ればいいものをそうでないからしわ寄せが来た感じです。
私の感覚からするとお子さんの誕生はつい先日のような気がするのですが、もうつかまり立ちですか。早いですねー。ウチの息子は就活の真っ最中です。残る楽しみは孫なんですが、孫、できるのかな……。自分自身ものんびりした人生を送ってしまって、就職と同時に家を出たので親からすれば結婚も唐突だっただろうし、子どもの動向が分からないからと愚痴を言ってはいけませんよね。
どこかの校長先生のようなことを言ってしまいますが、お子さんの成長が一番重要だと私は思います。PCなんてそれほど重要ではありません。クイズミリオネアではオーディエンスとかフィフティフィフティ、テレフォンは1回づつですが、実生活では使い放題です。どんどん使いましょう。なかなか仕様を決定してくれないお客様に「ファイナルアンサー?」とか冗談っぽく迫ったりしますが、実はかなり本気です。
Posted by ちょびちょび at 2016年04月02日 08:51
なるほどなるほど。かなりお忙しかったのですね。子供は毎日元気に家中をひっかきましてくれてますw家事と仕事を両立するのは大変ですが長女が少しずつお手伝いをしてくれるのでああ、お姉さんになったんだなあ、としみじみ思います。
仕事でもパソコン触らなきゃ忘れると思いなんとなくカウントダウンタイマーのようなものをVBAで作成しました。それはとりあえず動くのですが終了したら「停止」と表示されて点滅させようと思って次のコードを改良して点滅させる事が出来ました。Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'行列の挿入、削除を右クリックからできるようにする
If Target.Cells.Count > 1 Then
Exit Sub
End If
'点滅
Do
'B2がアクティブになったら点滅を停止
If ActiveCell.Address = "$B$2" Then
Range("B2").Interior.ColorIndex = 0
Exit Do
End If
'B2に値が入力されたら点滅を停止
If Range("B2").Value <> "" Then
Range("B2").Interior.ColorIndex = 0
Exit Do
End If
'B2のセルの色を赤色にする
Range("B2").Interior.ColorIndex = 3
Sleep 200
DoEvents
'B2のセルの色を塗りつぶしなしにする
Range("B2").Interior.ColorIndex = 0
Sleep 200
DoEvents
Loop
End Sub
↑これを特定のセルが「停止」と表示されたら点滅するように変えたんですが点滅させたいセルが10箇所くらいあり2箇所までは点滅させる事が出来たのですがそこから上手く動作しません。お知恵をお借り出来たら幸いです。
ちなみに指定時間と設備名を入力する箇所が10個あり入力するとカウントダウンが始まります時間が来てタイマーが停止したら特定のセルに停止と表示され赤点滅する、というものです。
Posted by takoyakiudon at 2016年04月09日 06:21
もしかしたら私の知識は古いかなーと思って、少し調べながらセルの点滅試してみましたが、複数個所は厳しいですよね。何か思いついたらコメントしますが、すぐは無理です。
Posted by ちょびちょび at 2016年04月11日 19:47
ありがとうございます。思いついたらお願いします〜。しかし折り紙上手いですね。子供に作ってあげたら喜びそう。
Posted by takoyakiudon at 2016年04月12日 08:31
熊本が大変ですね。こう頻繁に地震があると安全な地域なんてないんじゃあないかと考えてしまいます・・。
Posted by takoyakiudon at 2016年04月19日 20:21
う〜ん。10日経っても解決策が見つからない……。Excelじゃ難しいかも。
地震といえば、子どもが保育園に通ってた頃、阪神淡路大震災があったのですが、奥さんの実家が東京だというのでとりあえず避難してきた親子がいました。ほんの数日避難所にいただけでお子さんが虫歯になってしまったそうです。私の子育ての具体的な目標は虫歯ゼロ、正常な視力だったもので、印象に残る体験談でした。
おりがみは伯母が幼稚園の先生だった関係で、研修で学んだというものを復習代わりに私たちに教えてくれたという基礎があります。立体折り紙で代表的なものに薗部式というのがあるのですが、幼稚園児にこんなもの折れるのか? と、超疑問なものもありましたね。蟻地獄は手順が少なく短時間でできます。おりがみ3枚で作る独楽は御存じですか? フレーベルの独楽というのですが、写真や動画で教えてくれるものがあります。結構よく回ります。折紙会館とかおりがみハウスで講習会をやっているので、時間が取れると行くのですが、今は全然行けません。
Posted by ちょびちょび at 2016年04月24日 11:47
お久しぶりです。夏休みも終わりだいぶん?涼しくなりましたね。私も業務に子育て家事などあわただしい毎日を過ごしています。また仕事で困りごとがあったのでお知恵をお借りしたです。製品を棚に保管しているのですが棚に番地を作成して横並びでA-1、A-2・・2段目A2-1、A2-2、・・という感じでA4くらいまで番地を作成しそれがZ-1、Z-2・・Zまであります。そこに置いた製品の停滞日数と経過時間をシートに表示してますが製品を取った時に自動で在処を探してその場所にある製品を消したいです。シートのセルにはロット番号(10桁)と停滞日数と経過時間を表示してますが入力と出力?出庫を自動でやりたいです。棚の番地には製品をマックス2個まで置けるのですが一つ置く事もあれば2つ同じ場所に重ねて置く事もあります。製品を入力(置いた時)に一つならセル結合されて一か所が表示されてますが同じ場所に入力された時にセルが結合解除されて2つの製品が表示されてどちらかを出庫させたらまた結合がされるみたいなものは何か思い付きますでしょうか?ちょっと説明不足と言いますか上手く説明出来ず申し訳ありません。
Posted by takoyakiudon at 2016年09月02日 22:01
こんばんは。コメントは今朝確認したのですが、週末は車椅子の義母の付き添い当番があって、やっと帰宅しました。

え〜っと、
A-1、A-2……とかの棚情報シートと、入出庫を記録するシートがある。
処理実行の開始条件は製品を棚に置く、またはおろす。
そのときExcelに入出庫情報(入庫 or 出庫、棚情報、製品情報)を記録する。
1回の入出庫は1個ずつ。
みたいな認識で大丈夫ですか?
セル横並びに2個が一つの棚の情報を記録する場所だとする。仮にcell(1,1)、cell(1,2)に一つの棚の情報が記録されているとする。
元々の状態は製品0個、1個、2個の3種類。アクションは入庫か出庫とすると処理は6種類ですよね。
製品0個:セルが結合されていて空白?(棚に製品が何もないときはどのような状態ですか?)
 入庫されたとき:cell(1,1)にロット番号・停滞日数・経過時間を表示。
 出庫されたとき:エラー。(メッセージでも表示する?)
製品1個:cell(1,1)に製品情報が表示されている。結合されている。
 入庫されたとき:結合状態を解除、cell(1,2)にロット番号・停滞日数・経過時間を表示
 出庫されたとき:出庫情報を削除して0個の場合の状態にする。
製品2個:セルが結合されていなくて製品情報が表示されている。
 入庫されたとき:エラー。
 出庫されたとき:cell(1,1)、cell(1,2)のうち、該当する製品の方を削除した後セルを結合。

以上6種類の処理を下記の判定とマージを使って入出庫情報を入力した後にクリックするボタンを作ってマクロとして記録する方法ぐらいしか思いつかないかな……。

結合状態の判定
For i = 1 To n
If Cells(i, 1).MergeCells Then
'結合されている
Else
'結合されていない
End If
Next i

結合、解除の方法
Range(Cells(i, 1),Cells(i, 2)).Merge
Range(Cells(i, 1),Cells(i, 2)).UnMerge

ロット番号・停滞日数・経過時間が具体的にどのように記録されているのか(カンマとか改行で区切られているのですか?)一つの棚情報を表すセルは縦並びなのか横並びなのかとかもう少し分かれば具体的に説明できると思います。
Posted by ちょびちょび at 2016年09月04日 20:58
A-1 
ロットNO ********* 
停滞日数2.2    
経過時間12時間  
A-1
ロットNO 111111111
停滞日数0.0
経過時間36時間

↑一つの棚情報を表すセルは縦並びです
改行で区切られてます。(二つ製品を置いているイメージ)
ロットが置かれてない状態は空白となります

現在の時刻から停滞日数・時間を出したいです。
大変解りにくい説明で申し訳ありません。。

義母さんお体がすぐれないのですね・・私の母も脚が悪くなって来たので心配です。。父は元気なのですが。。

Posted by at 2016年09月05日 04:24
まだ途中ですが、開発のヒントになるところがあればと思いまして……。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php
Posted by ちょびちょび at 2016年09月05日 23:32
おー、ありがとうございます。棚番地と製品のロットNOは任意で入力しようかな、と思ってます。棚に番地のバーコードを印字していて最初にロット番号を入れ次に棚番地を入力して入庫、棚出しはロット番号入力のみでしたいなあ、って考えてます。あと検索機能も欲しくて検索したいロット番号を入力すると何処の場所に入っているか一目で解るような・・
なかなか言葉では難しいですよね・・。
Posted by takoyakiudon at 2016年09月06日 05:02
ちなみに以前教えて頂いたメソッドで検索機能としてADOのSQLで蓄積させたデータからロットNOをキーに引っ張ろうとしたら番地のA-1だけが空欄になってしまいます。これって何か抽出出来ない理由あるのでしょうか??フィールドとかSQL文など検索条件は正しいのですが。。
Posted by takoyakiudon at 2016年09月06日 13:57
あっ、SQLの件は解決しました。お騒がせしました
Posted by takoyakiudon at 2016年09月06日 16:44
こんばんは。Tana.xlsmを入れ替えました。製品が1個のときのセルの結合はどうしても必要ですか? 製品が2個あって左側が出庫されたら右側の製品を左側に寄せておく、のような処理だとあまり複雑な判断がなくて済みます。セルの結合、解除を行うと計算式の再設定とか少し面倒な気がします。
検索ボタンを追加してみました。入力された製品に一致する製品が置いてある棚の一覧がメッセージボックスに表示されます。表示シートの棚の背景色を変えるような処理でもいいかと思いますが、どんな感じがいいでしょうか。と、思ったけどもう検索処理は出来ているのかな。
Posted by ちょびちょび at 2016年09月06日 22:37
おー!ありがとうございます。結構イメージに近いです。これを元にやっていこうと思います!すごい助かります〜!
Posted by takoyakiudon at 2016年09月07日 06:34
お世話になります。あの作って頂いたコードで質問があるのですがFor Next文の
'棚状態確認
svcol = 0
svrow = 0
For row = 1 To 7 Step 2
For col = 1 To 9 Step 2
If CStr(Worksheets("棚").Cells(row, col)) = strTana Then
svcol = col
svrow = row
Exit For
End If
Next
と↓の
statana = ""
For row = 2 To 8 Step 2
For col = 1 To 10

どこの事を指してるんですっけ?
上のだと2つ飛ばしで2〜8までって事ですよね?
Posted by takoyakiudon at 2016年09月08日 17:34
rowが行でcolが列。ボタンの名前も9とか10じゃ分かりずらいですよね。すみません。
入出庫は1番上の棚を左から右に検索して、右端まで行ったら2番目の棚をまた左から右にという感じで、棚の名前(1,3,5,7行目)を調べています。
検索は製品を検索しているので、2,4,6,8行目をやはり上の段から調べています。
セルが結合されているときは一番若い番地(左上にあるセルですね)で参照します。
なので、製品の検索をするとき、セルを結合したり解除したりすると調べるセルが結合しているヤツかそうでないのかの判定が入り、大変面倒なコードになります。

'ボタン9(入出庫ボタン)
For row = 1 To 7 Step 2
For col = 1 To 9 Step 2

'ボタン10(検索ボタン)
For row = 2 To 8 Step 2
For col = 1 To 10
Posted by ちょびちょび at 2016年09月08日 21:29
大変助かりました!入庫した後にその入力された箇所を選択し点滅出来たらいいなあ、って思いますが可能ですか??
Posted by takoyakiudon at 2016年09月13日 11:35
入庫直後に決まったセル、決まった時間(または回数)だけというなら点滅はできると思います。
Posted by ちょびちょび at 2016年09月15日 06:55
あっ!それで!入庫後に決まったセルを点滅でお願いします!ちなみに停滞日数とかどのタイミングで更新されますか?セルをドラッグして関数を貼り付けないと更新してない気が・・汗
Posted by takoyakiudon at 2016年09月18日 21:26
遅くなってしまいました。すみません。

表示シートのWorksheet_Activateに再計算命令を入れるとシートを開くたびに再計算されます。
Private Sub Worksheet_Activate()
ActiveSheet.Calculate
End Sub

ここからはブリンク関係の修正。
Module1の一番先頭にこれを追加。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
一番下に以下を追加。
Sub Blink(row As Long, col As Long)
Const ColorIdx1 = 37
Const ColorIdx2 = xlColorIndexNone
For i = 1 To 10
With Worksheets("表示").Range(Cells(row, col), Cells(row + 1, col + 1)).Interior
If .ColorIndex = ColorIdx1 Then
.ColorIndex = ColorIdx2
Else
.ColorIndex = ColorIdx1
End If
End With
Sleep 500
Next
End Sub
ボタン9の棚に製品を入庫した直後に以下の2行を追加。
Worksheets("表示").Select
Call Blink(svrow, svcol)
SleepとかColorIndexの値を変えて調整して下さい。
Posted by ちょびちょび at 2016年09月22日 19:11
おぉー!ありがとうございます!
Posted by takoyakiudon at 2016年09月23日 05:24
お疲れ様です。
<ボタン9の棚に製品を入庫した直後に・・
↑というのは
Else '出庫の場合
If lngKosu = 0 Then
MsgBox ("入庫されていません")
Exit Sub
の構文の前になりますでしょうか??

※※※

あと別件で質問なのですがsql文でこのようなこのような感じで抽出・集計をしていますが
sql="SELECT 入力日,型番,count(入力日)as cnt FROM[ロット数集計$]group by 入力日,型番 order by count(入力日)desc"

これで別シートにあるデータから入力日の型番の個数を抽出したのですが抽出した個数をダブルクリックしたらその抽出元であるデータからその個数に該当するデータを表示させる事は可能ですか?
例えば
(元データ)
A3 B3 C3    D3  ・・・
コード入力日ロット番号 型番 ・・・



と並んだデータをsqlで
入力日 型番 個数
9/24  4444  8 

みたいに集計して個数の数字をビフォアーダブルクリックで
対象のデータを元データから抜き出す

A3 B3 C3    D3  ・・・
コード入力日ロット番号 型番 ・・・
コード入力日ロット番号 型番 ・・・
コード入力日ロット番号 型番 ・・・


みたいな感じで表示するイメージです。
Posted by takoyakiudon at 2016年09月24日 07:02
はい。Else '出庫の場合 の直前で間違いありません。


「入力」シートに抽出結果がこんな感じに表示されているとして。
□|A B C
--+-----------------
17|入力日 型番 個数
18|9/24 4444 8
19|9/24 5555 3

個数をダブルクリックしたあとの処理がこんな感じです。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const adOpenKeyset = 1
Const adLockReadOnly = 1
Dim dbCon As Object
Dim rst As Object
Dim strSQL As String
Set dbCon = CreateObject("ADODB.Connection")
dbCon.Provider = "Microsoft.Jet.OLEDB.4.0"
dbCon.Properties("Extended Properties") = "Excel 8.0"
dbCon.Open ThisWorkbook.FullName
Set rst = CreateObject("ADODB.Recordset")
If Target.Column = 3 Then
strSQL = "select * from [ロット数集計$] where 入力日=#" & Cells(Target.row, 1) & "# and 型番='" & Cells(Target.row, 2) & "'"
rst.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
Cells(Target.row, 5).CopyFromRecordset rst
End If
End Sub

型番のデータ型は何ですか? 4444とか5555としてテストするとセルを文字列に定義しても型が違うと言われてしまいます。
実際のデータに合わせて修正して下さい。Cells(Target.row, 5)というのはダブルクリックしたセルの右側に張り付けてみただけなので、表示したいところに変更して下さい。全然別のシートで実行するならシート名を修飾して下さい。
Posted by ちょびちょび at 2016年09月25日 09:57
四苦八苦しましたが無事目的を達成する事ができました。あとは入庫時の点滅に苦労してまする…
Posted by takoyakiudon at 2016年09月28日 15:58
お疲れ様です。sqlで抽出させたとき順番で並んで行くと思いますがカラムとカラムの間に空欄を入れる場合はどのようにしたら良いですか?抽出内容の隣に関数を入れたくて例えば「りんご」の内容を抽出して個数5個だったとして隣に関数を入れたいです。関数の右に次の項目「みかん」のデータを抽出したくて…
Posted by takoyakiudon at 2016年10月02日 08:18
select * from [ロット数集計$]
というSQLは書き方を変えると次のSQLと結果は一緒です。
select 入力日,型番,個数 from [ロット数集計$]

で、途中に何かカラムを追加したいときは定数(0とか空白とかその他の固定値)を追加します。
select 入力日,型番,'',個数 from [ロット数集計$]

単価と個数があって金額や消費税を計算したいときは、
select 単価,個数,単価*個数 as 金額,単価*個数*1.08 as 消費税込金額 from テーブル名
みたいな感じです。
Posted by ちょびちょび at 2016年10月02日 11:08
ありがとうございます。やってみます〜&#8252;
Posted by takoyakiudon at 2016年10月04日 07:48
はじめまして。
突然のコメント失礼します。
ネットで検索しているうちに以前に作成された「競艇トップ10」のファイルを見つけて
コメントさせて頂いてます。
元のVBAがあるから、勉強して加工すれば〜とか甘い考えでVBAを勉強しておりますが
まるでわかりませんw
項目としては日付・場番号・レース番号・出目・配当金・天気・風速・波高が欲しいのですが、作成していただけないでしょうか?
突然の厚かましいお願いなのですが、よろしくお願いいたします。
Posted by ワークス at 2016年10月07日 23:20
ワークスさん。はじめまして。
倉庫に入れておきましたので、ご確認下さい。

http://www.bec-co.sakura.ne.jp/dataland/Repository.php

Posted by ちょびちょび at 2016年10月08日 11:31
こんばんは。
お返事が遅くなりました。

突然の無茶振りにも、早急に作成していただき、ありがとうございます。
以前に作成されたものよりも、ややこしそうに見えるのは素人目だからなのでしょうか?w

折角VBAの書籍も購入しましたので
ちょっとずつでも勉強していきたいと思います。

今回の件、誠にありがとうございました。
Posted by ワークス at 2016年10月09日 19:55
ワークスさん。
ファイルのレイアウトを言葉で説明したものが仕様になります。
1行目に「STARTK」がある。
2行目に「KBGN」があり、先頭2桁は場番号である。次の「KBGN」が出てくるまで1開催場のデータ。
3行目は場名、開催日などがある、(開催日はファイル名から編集してますが、ここから参照してもいいですね)
4〜28行は今回の処理には不要。
29行目以降はレース情報が12個ある。
レースの先頭判定を「着」の前行としていますが、「1R」の行と判定してしまうと[払戻金]情報の「1R」と紛らわしいから。
レース情報は着順と結果データがある。
結果データは拡連複のみ3行あって、1行目には「拡連複」の文字があるが他行は空白である。
「KBGN」行が出てきたら2行目からの繰り返し。

分かりにくさの原因は、読み込み処理です。
Line Input #intFF, strRECで1行読んだらSplitで空白毎に区切って配列にしているから、単勝と2連単では出目までの空白の数が違うので配列の場所も違ってきます。払戻金に至っては3桁、4桁、5桁とあるのでそれも考慮しないといけません。
しかし、改めてコードを眺めると確かに分かりにくいので少し修正しました。入れ替えておきましたので、参考にして下さい。
ファイルを読んでセルに出力するだけの割には長い処理で「どこが変わったの?」と言われそうですが……。
Posted by ちょびちょび at 2016年10月10日 10:47
突然の不躾なお願いに始まり
あげくには、詳細の説明までしていただいて
本当にありがとうございます。

しかし残念ながら、説明は分かり易いのですが
自身のVBA理解度が低すぎて、何が何だか・・・。

ちなみに〜なんですが
今回作成して頂いたVBAなんですが
どれぐらいVBAを理解していれば作成出来るものなんでしょうか?
Posted by ワークス at 2016年10月11日 21:36
ワークスさん。
どれぐらい……難しい質問です。
書籍を購入されたなら、取り敢えず一読されることをお勧めします。それから実際に入力して試してみる。プログラムなんて、何か入力してチェックして編集した結果をどこかに書き出すだけです。入力元や出力先に種類があるので複雑に見えますが、OPEN,CLOSE,READ,WRITE,=(代入),+(演算),IF,LOOPと10種類にも満たない命令の組み合わせです。しかし、私の経験ですが、職業で全くの初心者から取り組んで「あ。そーだったのか」的な腑に落ちる瞬間まで半年から9カ月ぐらいかかったでしょうか。まあ、ざっと1000時間ぐらいですよね。これを週末、学習に割ける時間で割ると……。
軽く気が遠くなってきたのではないでしょうか。
Posted by ちょびちょび at 2016年10月12日 22:53
こんばんは。

一応購入した書籍は1週はしたのですが
な〜んとなくの雰囲気ぐらいは掴んだ程度でしょうか?w
1000時間とは・・・一桁多くないですか?って気がしないでもないですね。
仕事で使用する訳でもなく、期限がある訳でもないので
学ぶ喜びを噛み締めながら、コツコツと頑張っていきたいと思います。
Posted by ワークス at 2016年10月13日 01:23
ワークスさん。おはようございます。
はい。確かにプログラムを作れるようになるにはそれほど時間はかかりません。ただ、作れるようになってもなんか違和感があるというか納得できないというか、少し現場を離れると現地での記憶は一切なくなるというか、身についてない感が払拭されるまでに私は平均9ヵ月ぐらいかかるんです。もしかすると他の人はそれほど時間はかからないかもしれません。プログラム言語だけの問題ではなく、振り返ると引越し先で馴染むまでにもそれぐらいかかっていたような気がします。
VBAに関して何か調べようとしたらもうご存じかもしれませんが、私がお世話になっているサイトは「Excelでお仕事」とか「Office TANAKA」です。書籍でいまいち分からないところが納得できたりします。
Posted by ちょびちょび at 2016年10月13日 06:58


こんばんわー。
以前Worksheetsに10桁のロットNOを入力してある分だけデータを取得する方法を教えて頂いたのですが(かなり前です)
sql文が横書きだとうまくいくのですが↓のように縦にコードを記述した場合msg = Worksheets("Sheet1").Cells(i, 2)
で使ってるmsg を宣言しなくちゃいけなくなり実行しても同じ結果が繰り返し抽出されてしまいます
'レコード
Range("A2").CopyFromRecordset myRst
の部分の
SQLで結果を取得しても上書きしちゃってるのが原因かなあ、なんて思うのですがどのように治したら良いでしょうか??ちなみにsql文は
Sub SQL実行()
'Microsoft ActiveX Data Objects 2.0以上 参照設定
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim i As Long
Dim sSQL As String
'接続先サーバーを指定する
myCon.Open ConnectionString:= _
"Provider=MSDAORA;Data Source=××_ORCL;User ID=××; Password=××;"
'取得するテーブルを指定する

i = 6
x = 2
Do While Worksheets("Sheet1").Cells(i, 2) <> ""
msg = Worksheets("Sheet1").Cells(i, 2)
sSQL = ""
sSQL = sSQL & "select ××.××,"
sSQL = sSQL & " ××.××,"
.
.
sSQL = sSQL & "FROM ××.××"
sSQL = sSQL & "WHERE ××.××"

myRst.Open Source:=sSQL, ActiveConnection:=myCon

'レコード
sheets("sql抽出")Range("C"&x).CopyFromRecordset myRst
myRst.Close
i = i + 1
x = x + 1
Loop

End With
myCon.Close
Set myRst = Nothing 'オブジェクトの解放
Set myCon = Nothing
End Sub



Posted by takoyakiudon at 2016年11月12日 21:57
<'レコード
Range("A2").CopyFromRecordset myRst
の部分の・・・
書き間違いしました。sqlを別シートに抽出しているのがいけないのですかね??
Posted by takoyakiudon at 2016年11月12日 22:14
Worksheets("Sheet1").Cells(i, 2)、Sheets("sql抽出").Range("C"&x)などのようにセルはシート名で修飾されているので、別シートに抽出したから結果が期待通りにならないということはないと思います。

気になるのは下記の部分です。
sSQL = sSQL & "WHERE ××.××"

もう少し具体的に書くと
sSQL = sSQL & "WHERE テーブル名.カラム名 = '" & msg & "'"
ですよね? msg が毎回Sheet1のB6、B7、B8……と参照されているとすると、SQLの抽出結果は問題ないと思います。

結果ですが、データは1件と決まってますか? 2件以上あるとC2に1件目、C3に2件目と張り付けられてしまいますから、続けて実行すると2回目の結果は1回目の2件目に重なってしまいます。

もし、取得結果が何件あるか分からない場合はSheets("sql抽出")は
Cells(2,x)と横に張り付けていくか、結果を加工して1列にするか工夫した方がいいと思います。
Posted by ちょびちょび at 2016年11月13日 09:00
お久しぶりです。あれから3か月暇を見つけてはためしてみましたが上手くいきませんでした・・(´・ω・`)
えっと、整理しますとシート1のB6から下に向かってロットNOというフィールド名で番号が入っていてシート2にデータがありますB3からJ3までフィールドがありロットNO、品名、日時、項目4、項目5・・項目8までデータを適当に入れてあります。入力してある分だけのロットNOが一致したデータをシート1のロットNOの横に抽出させたかったです。会社のはoracleですが自宅はoracle環境でない為ワークシートにSQL使えるようにドライバーを.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & sPath & "; ReadOnly=True;" & _
"Extended Properties=Excel 8.0; HDR=YES;"とこの様にしてます。実際の自宅でのコードがSub 実験()
'Microsoft ActiveX Data Objects 2.0以上 参照設定
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim i As Long
Dim sSQL As String
Dim sPath As String

'接続先サーバーを指定する
With myRst
'Excelパス
sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name&
With myCon
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & sPath & "; ReadOnly=True;" & _
"Extended Properties=Excel 8.0; HDR=YES;"
.Open
End With
'取得するテーブルを指定する

i = 6
x = 2
Do While Worksheets("Sheet1").Cells(i, 2) <> ""
msg = Worksheets("Sheet1").Cells(i, 2)
sSQL = ""
sSQL = sSQL & "select Sheet2.品名,"
sSQL = sSQL & " Sheet2.日時,"
sSQL = sSQL & " Sheet2.項目4,"
sSQL = sSQL & " Sheet2.項目5"
sSQL = sSQL & " FROM Sheet2"
sSQL = sSQL & " WHERE Sheet1.[ロットNO] = Sheet2.[ロットNO] "

sSQL = sSQL & " and Sheet1.[ロットNO] = '" & msg & "'"

myRst.Open Source:=sSQL, ActiveConnection:=myCon

'レコード
Worksheets("Sheet1").Range("C" & x).CopyFromRecordset myRst
myRst.Close
i = i + 1
x = x + 1
Loop

End With
myCon.Close
Set myRst = Nothing 'オブジェクトの解放
Set myCon = Nothing
End Sub

ちなみにwebクエリってパラメータ化できるんですっけ?URLをエクセルのセルの何処かに打ち込んでそのデータを拾いたいニーズがありまして・・。

Sub macro110604a()
'Webクエリ作成
'最小限
With ActiveSheet.QueryTables.Add( _
Connection:="URL;http://yumem.cocolog-nifty.com/blog/2011/05/post-faec.html", _
Destination:=Range("A1"))
.Refresh
End With
End Sub
Posted by takoyakiudon at 2017年02月06日 22:17
おお。3ヵ月ぶりになりますか。

SQLの編集は単純にこれではダメですか? [Sheet1$].[ロットNO]の値はmsgの部分で編集できてますし。

sSQL = "SELECT [Sheet2$].品名,[Sheet2$].日時,[Sheet2$].項目4,[Sheet2$].項目5"
sSQL = sSQL & " FROM [Sheet2$] WHERE [Sheet2$].[ロットNO] = '" & msg & "'"

今回は自宅環境なので1個のConnectionでSheet同士連結できますが、実際はSheet2がOracleですよね。

しかし。Oracleだと問題になりませんが、自宅環境で問題となるのは[Sheet2$].[ロットNO]。
ロットNOの値には数字以外の文字は入ってますか? たまたま先頭のロットNOが「11111111」とかですと、数値項目と判定され、「'" & msg & "'」の部分でデータ型が違う! とか叱られてしまいます。

Excelには色々大きなお世話な機能があってこのサイトが詳しいです。
http://oyaji-pgm.blogspot.jp/2015/08/excel2013sqlexcel.html

WEBページの取得ですが、こんな感じでmacro110604aを実行すると取得できます。最後のパラメタp=1の部分を2,3,4……と変えると先頭ページだけではなく必要なページを自動的に取得してくれます。

Sub macro110604a()
Const strURL = "http://info.finance.yahoo.co.jp/ranking/?kd=1&tm=d&vl=a&mk=1&p=1"

With ActiveSheet.QueryTables.Add( _
Connection:="URL;" & strURL, _
Destination:=Range("A1"))
.Refresh
End With

End Sub
Posted by ちょびちょび at 2017年02月09日 10:56
ロットNOは数字しか入っていません。
ちなみにSQL文ですが
'レコード
'---追加 開始---
i = 6
x = 6
Do While Worksheets("Sheet1").Cells(i, 2) <> ""
msg = Worksheets("Sheet1").Cells(i, 2)
myRst.Open Source:="SELECT ロットNO,品名 FROM [Sheet2$] WHERE ロットNO = " & msg, のように横書きのsqlだとうまく動作しますが
↓のように横書きにするとダメですねえ
sSQL = ""
sSQL = sSQL & "select [Sheet2].[品名],"
sSQL = sSQL & " [Sheet2].[日時],"
sSQL = sSQL & " [Sheet2].[項目4],"
sSQL = sSQL & " [Sheet2].[項目5]"
sSQL = sSQL & " FROM [Sheet2$]"
sSQL = sSQL & " WHERE Sheet1.[ロットNO] = Sheet2.[ロットNO] "
sSQL = sSQL & " and [Sheet1].[ロットNO] = '" & msg & "'"

WEBクエリですがURLをセルに入力された値(URL)から抽出するVBAのコードって出来ますか??
Posted by takoyakiudon at 2017年02月10日 20:27
え〜と。簡単な方から。Sheet3のセルA1にURLが入力されているとして。

Sub macro110604a()
With ActiveSheet.QueryTables.Add( _
Connection:="URL;" & Worksheets("Sheet3").Range("A1"), _
Destination:=Range("A3"))
.Refresh
End With
End Sub

SQLですが、縦とか横の問題ではなくて、シート名は[Sheet2$]と$を付けて下さい。
FROMだけではなくて全部。ただ、お作法に従った書き方をしても「パラメタが少な過ぎます」と言われます。Sheet2の方は見出行が1行目になくてもテーブルとして認識されているようですが、Sheet1はA1に「ロットNO」がないとExcelが認識してくれないようです。Sheet2はそのままで、Sheet1はA1に見出し、A2以下がデータでしたら以下のコードでデータが取得できます。

i = 2
x = 2
Do While Worksheets("Sheet1").Cells(i, 1) <> ""
msg = Worksheets("Sheet1").Cells(i, 1)
sSQL = ""
sSQL = sSQL & "select [Sheet2$].[品名],"
sSQL = sSQL & " [Sheet2$].[日時],"
sSQL = sSQL & " [Sheet2$].[項目4],"
sSQL = sSQL & " [Sheet2$].[項目5]"
sSQL = sSQL & " FROM [Sheet2$] INNER JOIN [Sheet1$]"
sSQL = sSQL & " ON [Sheet2$].[ロットNO] = [Sheet1$].[ロットNO]"
sSQL = sSQL & " WHERE [Sheet1$].[ロットNO] = '" & msg & "'"
myRst.Open Source:=sSQL, ActiveConnection:=myCon

'レコード
Worksheets("Sheet1").Range("B" & x).CopyFromRecordset myRst
myRst.Close
i = i + 1
x = x + 1
Loop
Posted by ちょびちょび at 2017年02月11日 09:50
おお!ありがとうございます!会社で早速試してみます〜!
Posted by takoyakiudon at 2017年02月12日 13:48
お久しぶりです。毎日暑くて大変ですね。子共達とプールに行くのが楽しみになっております。お元気でしょうか??質問で恐縮なのですがよく別のフォルダのエクセルをVBAで開いて転記したりするのですがパスをVBAで指定するのではなくてシートの例えばA1とかにパスを入力したらそれを開く事が出来ますでしょうか?以前webクエリの質問をさせて頂いた際にConnection:="URL;" & Worksheets("Sheet3").Range("A1"), こんな感じで教えてもらったので同じように出来るか試したんですけど出来ずネットでも調べましたが解りませんでした。。また開く時に相手が読み取り専用ファイルなのでダイアログボックスを表示させず処理したいのですが・・。
Dim xlBook
Set xlBook = Workbooks.Open("C:\Users\111\Desktop\フォルダ\宿題.xlsm")

また別の話ですがエクセルに入力された値をwebページに直接転記するのを模索しておりましておススメのサイトとかありましたら教えて頂けないでしょうか??
Posted by takoyakiudon at 2017年08月11日 19:59
特に病気ではありませんが、介護でストレス溜まっています。私は絶対息子の嫁には迷惑をかけないぞ〜。割合適当に生きてきて、「絶対」とか強い決意をする性格ではないのですが、反対の立場になった場合を想像すると、誰か他の人の時間をこれほど拘束してまで生き長らえたくはないですねー。
自分でエサが取れなくなったら、ゾウさんみたいに自らお墓に出向いて死を待つ。ゾウさん偉い。あまりスプラッターなことにならず、自分が実践するにはどうしたらいいか。とか最近お気に入りのテーマです。
さて、下記のマクロを登録して、読み込みたいExcelのパスをA1セルに入力して実行して下さい。
読み込むExcelは先頭のシートにA1から隙間なくデータが入っているものとします。

Sub Sample1()
Dim filename As String
Dim strSheetName As String
Dim strMyBook As String
Dim strMySheet As String
Dim strValue As Variant
Dim MaxRow As Long
Dim MaxCol As Long
Dim i As Long
Dim j As Long
On Error Resume Next
strMyBook = ActiveWorkbook.Name
strMySheet = ActiveSheet.Name

filename = Cells(1, 1)
Open filename For Append As #1
Close #1
' If Err.Number > 0 Then
' MsgBox "ブックは開かれています"
' Else
' MsgBox "ブックは開かれていません"
' End If
Workbooks.Open filename:=filename, ReadOnly:=True
MaxRow = Range("A1").End(xlDown).Row
MaxCol = Range("A1").End(xlToRight).Column
strValue = ActiveSheet.UsedRange
Workbooks(strMyBook).Worksheets(strMySheet).Activate
For i = 1 To MaxRow
For j = 1 To MaxCol
Workbooks(strMyBook).Worksheets(strMySheet).Cells(i + 3, j) = strValue(i, j)
Next
Next
End Sub

コピー先に1セルずつデータを書き込まなくてもとか思われると思いますが、単純なコピペより途中で必要があれば編集したり順番を変えたりできるので、私はこの形式が扱い易いです。コメント部分のブックが開いている開いていないのとろこですが、必要があればこれで判定できます。

webに書き込みの件ですが、どのような場合に必要なのかな〜と疑問だったのですが、例えば荷物の問い合わせに使用している人がいるのですね。
下記のサイトが参考になりました。

http://www.vba-ie.net/form/text.html
https://oshiete.goo.ne.jp/qa/6581307.html
Posted by ちょびちょび at 2017年08月12日 23:09
そういえば以前介護されてる、っておっしゃってましたね。毎日お疲れ様です。冒頭の文を見て「あれ?息子さんご結婚されたんだったっけ?」と早とちりしてしまいました。VBAのコードありがとうございます。試してみます。WEBのサイトもありがとうございます。やりたい事はwebの入力画面にロット番号を入れると加工条件がVLookUPみたいに表示される会社のwebがあるのですが条件が表示されるテキストBOXみたいなのにカーソルがフォーカスされないと発動しないので大量に入力するのがとても大変なのでエクセルから転記出来たらいいな、と色々方法を探ってます。なんでもMAX50件は入力するので毎回しんどくて・・。
Posted by takoyakiudon at 2017年08月13日 22:16
webに大量データの入力が困難ということで、csvをインポートして直接テーブルを更新、結果を表示という処理をつい先月作成しました。LAMP環境でしたので、割と手軽にできました。システム担当の方にお願いができる環境でしたら、そちらの方が多分確実で早いかと……。
Posted by ちょびちょび at 2017年08月14日 06:49
ちなみにそれどんな感じで出来ますか??csvをインポート??
Posted by takoyakiudon at 2017年08月14日 23:59
先月お邪魔していた企業様では、せっかく検収データというのがExcelで上がって来るのに、Webの入金画面から1件づつ金額と入金日を手入力していたんですよね。その入金画面にファイル選択用のテキストボックスとボタンを1個追加して、ボタンが押されたら指定されたCSVを読み込んで処理します。本来、入力された値を登録ボタンとかあってデータを更新しますよね。それがCSVの値から更新する感じです。
お使いのシステムがパッケージであるとか、カスタマイズが容易ではない場合は仕方ありませんが、もし社内で内製しているようでしたら、今まで手入力で1日何分かかっていたものが、自動入力なら5秒ですよとか提案書を提出してみてもいいのではないでしょうか。風通しの良い会社であれば「あの〜。ご相談が……」とお話だけで済むかもしれませんし。手入力だとミスもありますしね。Excelを直接読み込まなかったのは、余計なライブラリを追加しなければならなくて、その承認が取れなかったためです。CSVなどのテキストファイルであればPHPの標準機能で読めます。まずは入力先のシステムが何でできているかの調査ですね。入力項目に日本語があると少し面倒ですが、英数字だけで、データと入力先が単純なキーで1対1ならば1日もあれば追加できる機能であると思います。
だめならば、例のお問い合わせ自動入力マクロをカスタマイズしましょう。
Posted by ちょびちょび at 2017年08月15日 06:48
明けましておめでとうございます。
数か月掛けて以前の↑の内容を改善提案を社内のシステム課にしましたが対応してもらえませんでした。。システムはVBベースで作成されております。入力項目は英数字のみでした

ちなみに別件ですがsql文を書く時に重複せず抽出する書き方ってどういう風になりますかgroup by を使うんですよね?たとえば1111というテーブルIDの型番ってカラム名を重複無しで抽出させたい場合です。
Posted by takoyakiudon at 2018年01月29日 10:38
重複無しで抽出は調べて色々してたら出来ました!
Posted by takoyakiudon at 2018年02月04日 12:44
うわ〜。もう2週間サーバログインしてなかったんだ……。立春も過ぎてしまって、なんとご挨拶すべきなんでしょうか。
せっかく質問してくれたのに、見てなくてすみません。今回、またハズレな案件に関わってます。私は銀のイルカなんですけど(占いの本とか年末に読んだりしません?)今年好調だなんて、ありえないですね。いや。これで好調なんだったら、来年以降が怖い……。四柱推命だと2020、2021が絶不調らしいので、今よりまだ下があるのか? と慄いてます。今回の案件、新規開拓に行くのが寒いからと、つい横着をして前回と同じ企業で違う部署に横滑りしてしまったのですが、同じハズレな案件でも違う企業に行けば良かったと後悔してます。社食も飽きてきたしなー。B型インフルエンザにもかかってしまったし、新年からあまり良いことはありません。今回の担当者と半年一緒に仕事するのは辛いな〜。
Posted by ちょびちょび at 2018年02月13日 00:26
相変わらずお忙しくされてるんですね〜。お身体にお気をつけくださいませ。以前sqlをループさせる方法を教えて頂いたのですがOracleで大量に処理させると遅くなってしまいます。いろいろな高速化の手法を試したんですけど上手くいきません。何かいい方法無いですかねえ…
Posted by takoyakiudon at 2018年02月15日 16:39
実行計画は確認しましたか? まだでしたら、Oracle 実行計画 とかで検索し、確認してみて下さい。
どこにどれぐらい処理時間がかかっているか分かるので、一番大きな数字のあたりをじっくり見て下さい。ヒントがあるはずです。インデックス一つで劇的に早くなったりすると楽しいです。
Posted by ちょびちょび at 2018年02月16日 13:31
おかげさまで処理を半分くらいにまで削減する事が出来ました!ありがとうございます!インフルエンザ大丈夫でしたか?我が家も息子がインフルエンザになり大変です。。まだまだ寒いのでお互い頑張りましょう。
Posted by takoyakiudon at 2018年02月18日 04:45
こんにちは。マクロのパスワードvbaのパスワードの解除方法なんかはよくネットに出てますが逆に解除されない方法ってあるんでしょうか?
Posted by takoyakiudon at 2018年03月24日 21:58
どれだけ厳重にパスワードを設定しても、解除をするのが面倒になるだけで、解除できなくなる方法はないと思います。特にExcelファイルなどではフォーマットが決まっていますし、同じExcelを2個用意してそれぞれ違うパスワードをかけてバイナリで比較すれば、どの辺にパスワードが書き込まれているか、推測は容易です。強力な保護方法を考えつく人がいれば、それを解除しようと努力する人が必ずいますよねー。私の性格はどちらかというと解除しようとする人かな。自分から何か作ろうという意欲はないけど、パズルを解くのは好きです。
システムの運用で肝心なのは、パスワードが解除されてしまった後、いかに早く察知して対応するかを考えておくことですよね。どの程度の被害が予想されるか、どうしたら回復できるか……。ま、立派なシナリオ作っておいても、何か不具合が出ればいつもバタバタで、とりあえずバックアップを復元して再起動とか、毎度芸がないのですが……。
Posted by ちょびちょび at 2018年03月25日 11:29
なるほど。つまり解除されない方法ってのは無いと考えねば行けませんね。ちなみにWindowsAPIを無効にする事は出来るんでしょうか?解除するツールに使われてる事が多いので。
Posted by takoyakiudon at 2018年03月26日 01:10
う〜ん。WindowsAPIを無効にする方法ですか……。
いつも使うだけで無効にする方法考えたことなかったですね。
「Windows の機能の有効化または無効化」というのはありますが、WindowsAPIとか、ズバリな項目はないですよね。
一般的にExcelとかAccessのVBAだと覗いたり改造されやすいので、どうしても見せたくない機能はTransact-SQLとか(OracleだとPL/SQL)で作ってセキュリティはサーバだのDBに任せるという方向だと思います。
Posted by ちょびちょび at 2018年03月27日 06:30
むずかしいですね(´・ω・`)外部からのアクセスがあり改変されてる形跡があってちょっと困ってます。特に大きな被害は無いですがとりあえずマクロを守ろうとしてますが正直どうしていいか解んないです。
Posted by takoyaki-udon at 2018年03月27日 14:33
マクロ部分をアドインにして本体から切り離して、必要なときだけ読み込みという方法があるようですね。
Posted by ちょびちょび at 2018年03月27日 21:51
ちなみにそれどのような感じで実行するのですか??
Posted by takoyakiudon at 2018年03月28日 19:01
ええっと。マクロを保護したいExcelにボタンはいくつありますか? 機能別にマクロを分けて、それをアドインで保存する。マクロ抜きのExcelを開いて、作っておいたアドインを登録。元々シートやフォームにあったボタンがツールバーに移動する感じですね。
Posted by ちょびちょび at 2018年03月28日 20:22
こんにちは。以前
<やりたい事はwebの入力画面にロット番号を入れると加工条件がVLookUPみたいに表示される会社のwebがあるのですが条件が表示されるテキストBOXみたいなのにカーソルがフォーカスされないと発動しないので大量に入力するのがとても大変なのでエクセルから転記出来たらいいな、
って質問させて頂いんたのですが(去年の8月くらいです。)会社がシステム改良に動いてくれないので色々調べて自分でやる事にしました。
(例)
Sub useButton()
Dim ie As InternetExplorer
Dim button As HTMLInputElement

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.impressjapan.jp/appended/3384/4-8.html"
While ie.rwadyState<> 4 Or ie.Busy =True
DoEvents
Wend

For Each button In ie.document.getElementsByTagName("INPUT")
If button.Type = "button" And button.Value = "ボタン2" Then
button.Click
Exit For
End If
Next
ie.document.getElementsByName("1111[]")(0).value_=Range("Sheet1!$B$2").Value
.
.
END Sub
みたいな感じでWEBのテキストボックスに値を入力するまではいけたのですが肝心のWEBがその後動きません。何がいけないでしょうか?。。
ちなみにWEBは社内のインターネットエクスプローラーでテキストBOX一個に付き10桁のロットNOを入力します。それが20件MAXで入力できるのですがロットNOを入れて隣のテキストBO]にフォーカスされるとVLOOKUPみたいにそのロットNOに該当したデータを表示させます。手入力やロットNOをコピーして貼り付けると機能しますがVBAでやろうとすると値はwebのテキストBOXに入りますが動きません。。
webのソースをみると
//検索処理
function doGetData(obj,lineNo)
//ライン行
obj.lineNo.value=lineNo;
//コマンド
obj.lineNo.Value='select';
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
obj.elements['*****'][linNo].focus();
そのあと
function ClearData(obj)


function chkDate(obj)
と機能が続きます。
これらの処理もコードで書かないと動かないって感じでしょうか??
ちなみに処理が難しくなるなら起動しているIEにエクセルのデータを張り付ければうごくんじゃあ??って事で
Sub SearchIE1()

Dim colSh As Object
Dim win As Object
Dim strTemp As String
Dim objIE As Object
Set colSh = CreateObject("Shell.Application")

For Each win In colSh.Windows

If TypeName(win.document) = "HTMLDocument" Then

If InStr(win.document.Title, "PC Watch") > 0 Then

Set objIE = win

Exit For
End If
End If
Next

If objIE Is Nothing Then
MsgBox "探しているIEはありませんでした"
Else
MsgBox objIE.document.Title & "がありました"
End If

End Sub
↑のelseのあとエクセルの値を起動済みのIEに貼り付けようとしたんですがコードがイマイチ解りませんでした。
長文で申し訳ありませんがお解りになりますでしょうか?。。
Posted by takoyakiudon at 2018年04月28日 12:41
web本体の処理でdoGetDataは、onChangeイベントか何かで呼び出されているんですか? また、IEのバージョンは何でしょう。10以上だと問題は少ないんですが、8以下だと、謎な挙動にwebの開発した方も悩まされていると思います。
取り敢えずバージョン教えて下さい。
Posted by ちょびちょび at 2018年04月30日 08:55
バージョンは11になります。
Posted by takoyakiudon at 2018年04月30日 12:38
<input type="text" name="1111[]"Size="13"maxlength="10" value=""onChange"doGetData(this.form,1)">とあるのでonChangeイベントだと思います。
Posted by takoyakiudon at 2018年04月30日 20:38
htmlの部分が分かりませんので、推測ですが、
<input type="text" name="1111[]" onChange="doGetData(this,1)">
だとすると、テキストボックスに値がセットされた後、
objIE.Navigate "javascript:doGetData(ie,1111[]);"
のようなコードを入れると検索処理を始めるのではないでしょうか。
Posted by ちょびちょび at 2018年04月30日 22:10
ありがとうございます。明日会社で試してみます!!
Posted by takoyakiudon at 2018年04月30日 22:44
ie.document.getElementsByName("1111[]")(0).value_=Range("Sheet1!$B$2").Valueのあと
ie.Navigate "javascript:doGetData(ie,1111[]);"としてみましたがうまくいきませんでした。。ううむ
Posted by takoyakiudon at 2018年05月01日 19:17
会社からデータを持ち出せないのでソースを手入力してみました。だいたいこんな感じなんですが・・長くなりますが。。エラーになるので途中までしか書けませんでした
<link rel="stylesheet" href="/0/isp/stylesheet/back_gr.css" type="text/css" />
<html>
<head>
<title>0000</title>
<script language="JavaScript">
<!--
//起動時実行スクリプト
function onLoadScript()
//メッセージ
var Message="";
if (!(Message =="")&&! (!(Message =="null")
alert((Message);
//初期値のフォーカスをとる
if(document.forms[0].elements['1111[]'][0].value=="")
document.forms[0].elements['1111[]'][0].focus();
document.forms[0].elements['1111[]'][0].select();
else
//メッセージ<>""の場合
if(message!="")
//設備NO=ブランクの場合→ロットNO
if(document.forms[0].elements['2222[]'][0].value=="")
document.forms[0].elements['1111[]'][0].focus();
document.forms[0].elements['1111[]'][0].select();
else
//設備NO<>ブランクの場合→設備NO
document.forms[0].elements[2222[]'][0].focus();
document.forms[0].elements['2222[]'][0].select();
else
if(document.forms[0].elements['1111[]'][0].value=="")
document.forms[0].elements['1111[]'][0].focus();
document.forms[0].elements['1111[]'][0].select();
else
//設備NO
document.forms[0].elements['2222[]'][0].focus();
document.forms[0].elements['2222[]'][0].select();
"//検索処理
function doGetData(obj,lineNo)
//ライン行
obj.lineNo.value=lineNo;"
"
//コマンド
obj.lineNo.Value='select';
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
obj.elements['*****'][linNo].focus();
"
//クリア処理
function ClearData(obj)
//コマンド
"obj.lineNo.Value='clear';
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
obj.elements['*****'][0].focus();
"
//サブミット処理(エラーチェックあり)
function chkData(obj)
//コマンド
obj.cmd.value='insert';
var cnt =20;//ロットNO入力フォームの行数
//ロットNOの入力チェック
inpCnt=0;
for(i=0;i<cnt; i++)
if (Trim(obj.elements['1111[]'][i].value) !="")
inpCnt=++;
//ロットNOの桁数チェック
if (Trim(obj.elements['1111[]'][i].value.length<10)
alert("ロットNOを修正してください。");
obj.elements['1111[]'][i].focus();
obj.elements['1111[]'][i].select();
return false;
//ロットNOの重複チェック
for(i=0;i<cnt; i++)
if (I =j)
if(obj.elements['1111[]'][i].value==obj,elements['1111[]'][i].value)
alert("重複しています。修正してください");
obj.elements['1111[]'][i].focus();
obj.elements['1111[]'][i].select();
return false;
//加工条件の温度チェック
if(obj.elements[3333[]'][i].value=""||isNaN(obj.elements[3333[]'][i].value))
alert("温度を入力してください");
obj.elements['3333[]'][i].focus();
obj.elements['3333[]'][i].select();
return false;
//加工条件の電圧チェック
if(obj.elements[4444[]'][i].value=""||isNaN(obj.elements[4444[]'][i].value))
alert("温度を入力してください");
obj.elements['4444[]'][i].focus();
obj.elements['4444[]'][i].select();
return false;
//加工条件のj時間入力チェック
if(obj.elements[5555[]'][i].value=""||isNaN(obj.elements[5555[]'][i].value))
alert("温度を入力してください");
obj.elements['5555[]'][i].focus();
obj.elements['5555[]'][i].select();
return false;
//加工条件の評価入力数チェック
if(obj.elements[6666[]'][i].value=""||isNaN(obj.elements[6666[]'][i].value))
alert("温度を入力してください");
obj.elements['6666[]'][i].focus();
obj.elements['6666[]'][i].select();
return false;
//設備の入力チェック
if(obj.elements[7777[]'][i].value="0"||isNaN(obj.elements[7777[]'][i].value))
alert("温度を入力してください");
obj.elements['7777[]'][i].focus();
obj.elements['7777[]'][i].select();
return false;
//Aランクの入力チェック
if(obj.elements[8888[]'][i].value=""||isNaN(obj.elements[8888[]'][i].value))
alert("温度を入力してください");
obj.elements['8888[]'][i].focus();
obj.elements['8888[]'][i].select();
return false;
//Bランクの入力チェック
if(obj.elements[9999[]'][i].value=""||isNaN(obj.elements[9999[]'][i].value))
alert("温度を入力してください");
obj.elements['9999[]'][i].focus();
obj.elements['9999[]'][i].select();
return false;
//合否判定入力チェック
if(obj.elements[ああああ[]'][i].value=!'1'&&obj.elements[ああああ9[]'][i].value!='0'))
alert("判定には0または1を入力してください");
obj.elements['ああああ[]'][i].focus();
obj.elements['ああああ[]'][i].select();
return false;

if (inpCnt == 0)
alert("ロットNOデータを入力してください");
obj.elements['1111[]'][i].focus();
obj.elements['1111[]'][i].select();
return false;
msg="このデータで追加します。よろしいですか?”;
if (confirm(msg))
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
return true;
else
return false;
//文字列のトリム
function Trim(str)
str=str.replace(/^[ ]+/,"");
str=str.replace(/^[ ]+$/,"");
return (str);
//ファンクションキートラップ
function check()
//alert(event.keyCode);
if (event.keycode==119)
//F8キー押下の場合は「更新」ボタンを押す
chkData(document.forms[0];
else if (event.keyCode==13)
return false;
else
return;//スルーする

Posted by takoyakiudon at 2018年05月01日 22:29
あっエラーになるっていうのはこのコメントの文字数を超えちゃうって意味です。
Posted by takoyakiudon at 2018年05月02日 08:35
doGetData(ie,1111[])の1111[]だと入力した値になると思うので、行番号を指定できませんか? htmlでdoGetDataの呼び出し元とか参照できれば、もう少し具体的にアドバイスできると思うのですが…。
Posted by ちょびちょび at 2018年05月02日 13:34
私も勉強不足で行番号を指定というのがよく解りません。。
ですがロットNOのテキストBOXがie.document.getElementsByName("1111[]")(0)
ie.document.getElementsByName("1111[]")(1)
ie.document.getElementsByName("1111[]")(2)
というVBAのコードで上から順にWEBに値だけは入れられるんですが・・・
Posted by takoyakiudon at 2018年05月02日 19:00
doGetDataの呼び出し元が↓の検索処理からコマンドの終わりまでがひとくくりにされてるっぽいのでobj.action='/@/@/@/ResulutInputServlet';
が参照元って事ですかね??



"//検索処理*************

function doGetData(obj,lineNo)
//ライン行
obj.lineNo.value=lineNo;"
"
//コマンド
obj.lineNo.Value='select';
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
obj.elements['*****'][linNo].focus();
"
********************
Posted by takoyakiudon at 2018年05月02日 19:09
申し訳ありません。お昼食べながら話をしながらスマホで返信してたので、全部ちゃんと見てなかったようです。
doGetData(this.form,1)だったら、
objIE.Navigate "javascript:doGetData(ie.document.forms[0],1);"
かなー?
行番号と言っているのは("1111[]")(0)の(0)の部分のことで、最初の行が0、次が1とカウントアップさせながらobjIE.Navigateしていくんじゃないかなと思います。
Posted by ちょびちょび at 2018年05月03日 22:51
なるほどなるほど。ありがとうございます。GWが空けましたら会社で試してみます!
ちなみに最初のほうで質問させて頂いたのですが
既に開いているIEのテキストBOXにエクセルのデータをコピーして貼り付ける事は可能でしょうか?
目的のIEが開かれていればエクセルに入力してあるロットNOがテキストBOXに貼り付けられて行く感じです。単純にコピー&ペーストです。下記のようなコードで起動の有り無しの判定までは会社で出来ましたが値を持ってくる事は出来ませんでしたSub SearchIE1()
Dim colSh As Object
Dim win As Object
Dim strTemp As String
Dim objIE As Object
Set colSh = CreateObject("Shell.Application")
For Each win In colSh.Windows
If TypeName(win.document) = "HTMLDocument" Then
If InStr(win.document.Title, "PC Watch") > 0 Then
Set objIE = win
Exit For
End If
End If
Next
If objIE Is Nothing Then
MsgBox "探しているIEはありませんでした"
Else
objIE .document.getElementsByName("1111[]")(0).value_=Range("Sheet1!$B$2").Value
MsgBox objIE.document.Title & "がありました"
End If
End Sub
Posted by takoyakiudon at 2018年05月03日 23:39
objIEまで取得出来ているのなら、setfocusしてあげれば張り付けはできそうです。帰宅したら試してみますね。
Posted by ちょびちょび at 2018年05月04日 09:27
こんばんは。本日から出勤だったのでsetfocusでやってみましたがオブジェクト変数WITHブロック変数がありませんとエラーになります。。また最初の質問のテキストボックスに値がセットされた後、
ie.Navigate "javascript:doGetData(ie.document.forms[0],1);"としてみたんですが値が入っても実行されませんでした。。
Posted by takoyakiudon at 2018年05月07日 02:49
Set colSh = CreateObject("Shell.Application")の方ですが、ウチの環境localとレンタルサーバーのサイトで試してみましたが、
colSh.Windowsのところでcountが0となってしまって、setfocusどころかテキストボックスに値を入れるところまでもできませんでした。ieではなく
chromeだとcolSh.Windows.countの値は0以上になり何かは取得できているようですが、objIE.documentのdocumentあたりが黄色くなって変数がありません云々のエラーがでます。すみません。Edgeだからダメなのかなー。エージェントをie11にしてみても結果は同じなんですよね。
ie.Navigate "javascript:doGetData(ie.document.forms[0],1);"ではだめでしたか。
これは私の方ではonChangeイベントのjavascriptが動くんですよね。テストなのでalert1行というお粗末なものですが…。ie.Navigateの具体的なエラーは何ですか?
vbaの方のエラーと、もしかしてwebの方でも何か出てたりしませんか?
Posted by ちょびちょび at 2018年05月07日 06:38
Vbaのエラーもwebのエラーも出ません。値は入れれますが何も起こらない、って感じです。何も起こらないのでIEのテキストボックスに試しに手入力するとタブが増えてもう1つ該当のサイトが開かれたりするときがあります。もう少しいじってみますね
Posted by takoyakiudon at 2018年05月07日 16:24
もう解決してるかもしれませんが、職場のイントラ環境では
Dim pwin As HTMLWindow2
で動きました。普通(?)のインターネット環境では同じコードでもオブジェクトを認識することもできません。何故……。htmlだとかtitleのチェックをしてセルの値をテキストボックスに入力した後、
Set pwin = ie.document.parentWindow
pwin.execScript "doGetData(ie,1)"
のようなコードでjavascript のfunctionが動きました。
Posted by ちょびちょび at 2018年05月08日 19:43
おはようございます。実はまだ解決してませんでした笑参照設定をどの項目にチェック入れてよいか解らずあたふたしてました。htmlはチェック入れてるのですが具体的にどの項目なりますでしょうか?(´・ω・`)?
Posted by takoyakiudon at 2018年05月09日 05:44
参照設定は
Microsoft HTML Object Library
Microsift Internet Control
です。
余談ですが、職場では大丈夫なんですけど、家ではExcelを保存しても次に開くと参照設定が外れてるんですよね。バージョンの違いだとは思うんですけど、これもよく分からない現象です。だから他に選択の余地がある場合はMicrosoftを避けるんですよねー。
Posted by ちょびちょび at 2018年05月09日 06:36
その両者を参照設定させてるんですけどSet pwin = ie.document.parentWindowがそのメッソドはサポートされていませんってエラーになるんですよね。。なんでだろう・・
Posted by takoyakiudon at 2018年05月09日 17:15
Dim pwin As HTMLWindow2を入力するとき、変換候補は出てきますか? 2ではなく3とか4かもしれません。
Posted by ちょびちょび at 2018年05月09日 17:35
pwin.execscriptをGoogleで検索し、「ページのスクリプトを実行するVBAコード」というサイトを参考にしました。今回ご質問の件は、家の環境では実行できず、ソースを全文記憶する根性もありませんので、アドバイスがいつも以上にいい加減になってしまい、申し訳ありません。多分元のコードを見れば何か分かることがあると思います。
Posted by ちょびちょび at 2018年05月10日 13:38
いえいえ、こちらこそ毎回無理を言って申し訳ありません。ちなみにこのフォームにメールアドレス書き込むと公開されちゃいますっけ?(´・ω・`)?
Posted by takoyakiudon at 2018年05月11日 00:55
いえ。アドレスは公開されませんよ。時々ダイレクトにメールを送ってくる人もいます。どこかに書いたのでしょうが、私自身も場所が分かっていなかったりします。アマゾンのプレゼント券なんて、そうしたメールで初めて知ったし。
Posted by ちょびちょび at 2018年05月11日 07:17
変換候補はHTMLWindow2しかそれ系は出てきませんでしたProxyやらWandoptionElement,wndSelectElementみたいなのは候補で出ますが・・
Posted by takoyakiudon at 2018年05月11日 10:33
こんにちは。あれからいじっていたらそのメッソドはサポートされていませんってエラーは何故か出なくなりました。ですがその代り実行時エラー-2147352319エラー80020101のため操作を完了できませんでした。ってエラーが出るようになりました。これってソースに/起動時実行スクリプト
function onLoadScript()
//メッセージ


ってあるので起動時のスクリプトを実行してないからなんですかね??
Posted by takoyakiudon at 2018年05月12日 10:33
オートメーションエラーですか…。onLoadScript()は、VBAでCreateObjectするなり、手動で目的のサイトを開いた時、既に実行されているような気がしますが。複数回実行しても問題がなさそうな処理だったら、doGetDataを呼ぶ前にonLoadScript実行してみますか? セミコロンで区切って書けば続けて実行してくれるはずです。実行時エラー-2147352319はVBAでjavascript呼ぶ行で出るのですか?
Posted by ちょびちょび at 2018年05月14日 00:09
Set pwin = ie.document.parentWindow
pwin.execScript "onLoadScript()"
ie.document.getElementsByName("1111[]")(0).value_=Range("Sheet1!$B$2").Value
pwin.execScript "doGetData(ie,1)"みたいな感じで書いてpwin.execScript "doGetData(ie,1)"でエラーが出てますねオンロードのスクリプトはとりあえず実行してみました
Posted by takoyakiudon at 2018年05月14日 13:25
doGetData(ie,1)はieではなくてpwinかなー。ieとかpwinの中身をウォッチ式で見て、thisだのformっぽい項目ないですか?
Posted by ちょびちょび at 2018年05月16日 00:17
Thisとかfromは無いですねえ…式はpwin値はobject型はhtmlwindow2ってなってます
Posted by takoyakiudon at 2018年05月16日 12:29
fireEventはどうでしょう。スマホなので適当な例しか出せませんが、下記を環境に合わせるとjavascript動きませんか?
objIE.Document.all.JYO.fireEvent ("onchange")
Posted by ちょびちょび at 2018年05月16日 13:34
fireEventは参照設定が必要ですか??明日会社で試してみます。
Posted by takoyakiudon at 2018年05月16日 19:50
新たな参照設定は不要です。

Sub macro2()
Dim objShell As Object
Dim objWindows As Variant
Dim objIE As Object
Set objShell = CreateObject("Shell.Application")
For Each objWindow In objShell.Windows
If TypeName(objWindow.document) = "HTMLDocument" Then
'タイトルの判定は省略
Set objIE = objWindow
Exit For
End If
Next
objIE.document.all.tbltype.selectedIndex = 1
objIE.document.getElementById("tbltype").FireEvent ("onChange")
End Sub

<select id="tbltype" onChange="changecond();">

既に起動しているIEのコンボボックスの値を何か選択してonChangeイベントを実行する処理です。今テストに使えるhtmlでonChangeがあるのがここだけだっだので例としてはあまりよくないかもしれませんが、
objIE.document.all.tbltype.selectedIndex = 1
のところをExcelのセルからテキストボックスに値を代入する処理に変更すれば、実行できそうな気がします。
Posted by ちょびちょび at 2018年05月16日 23:47
お初にお目にかかります。初めまして。VBAで検索していたところこちらのブログを拝見しました
写真報告書を作成するエクセルのツールを以前拝見しDLして使用させて頂いておりました。
活用させて頂き大変便利でした。この場を借りてお礼を申し上げます。私は半年前から工場に勤務しておりますがエクセルで私自身も何か出来ないか
と思い、少しずつ勉強を始めてみたのですがWEBや書籍でもなかなか実現しそうになかった表の並び替え問題にぶち当たりまして
もしかしたらプロの方ならいい方法がお解りになるのではないかと思いいきなりで大変失礼かと思いましたが
ここで質問させて頂けないでしょうか。また突然の質問ですし、こちらをもしかしたらもう見られて無いかも知れないのでその際はお気にされなくて結構です。
Sheet1に見出しフィールドがA1〜J1に[コード]、[コードNo]、[製品番号]、[品名]、[予定日]、[実施日]、[総数]、[タイプ]、[トレーに入れる量]、[トレーの数]とありデータが下に向かって何件も並んでいます。
それを以下の条件で並び替えたいのですがとても複雑で
@[タイプ]は同一種類のみ
ASheet2に設定した[タイプ]を最優先させる。設定が無ければスルーする
B[トレーの数]のデータの値が↓のセルに向かって合算で30になる(一つ一つのデータのトレーの数はバラバラで30を超過しない1〜29枚の範囲)
C[予定日]が早い順にならびかえ
D[実施日]が現時点の時刻より10日以上経過しそう(8日〜9日)なら予定日より優先され繰り上げて優先される(でもトレーの数は合算で30以上超過しないように)
E並び変えたデータの集団のセルが色が変わる

※オプションボタンでトレー数変更切り替え設定→80枚設定

というような感じです。上手く説明出来なかったかも知れませんが上記内容でご理解頂いてお力を頂けたら大変助かります。突然の書き込みで申し訳ございません。
ちなみにエクセル2010〜のバージョンです。
Posted by nephron at 2018年09月29日 07:34
どうも。初めまして。蟻地獄のスクロールが面倒になってきたので、蟻地獄2に移動します。
http://chobi2dataland.sblo.jp/article/165654052.html
Posted by ちょびちょび at 2018年09月30日 02:25
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

この記事へのトラックバックURL
http://blog.sakura.ne.jp/tb/165654036

この記事へのトラックバック