そーいう名前の折り方なんです。これは360枚。
2015年10月13日
この記事へのトラックバックURL
http://blog.sakura.ne.jp/tb/165654036
この記事へのトラックバック
http://blog.sakura.ne.jp/tb/165654036
この記事へのトラックバック
検索ボックス
| 日 | 月 | 火 | 水 | 木 | 金 | 土 |
|---|---|---|---|---|---|---|
| 1 | 2 | 3 | ||||
| 4 | 5 | 6 | 7 | 8 | 9 | 10 |
| 11 | 12 | 13 | 14 | 15 | 16 | 17 |
| 18 | 19 | 20 | 21 | 22 | 23 | 24 |
| 25 | 26 | 27 | 28 | 29 | 30 | 31 |
最近の記事
最近のコメント
蟻地獄２ by nephron (12/12)
蟻地獄２ by nephron (06/10)
蟻地獄２ by nephron (12/13)
蟻地獄２ by nephron (11/21)
蟻地獄２ by nephron (11/13)
蟻地獄２ by nephron (06/10)
蟻地獄２ by nephron (12/13)
蟻地獄２ by nephron (11/21)
蟻地獄２ by nephron (11/13)
最近のトラックバック
カテゴリ
日記(51)
過去ログ
2015年10月(3)
2011年04月(6)
2011年01月(3)
2010年12月(4)
2010年11月(3)
2010年10月(7)
2010年09月(4)
2010年08月(5)
2010年07月(7)
2010年06月(3)
2010年05月(6)
2011年04月(6)
2011年01月(3)
2010年12月(4)
2010年11月(3)
2010年10月(7)
2010年09月(4)
2010年08月(5)
2010年07月(7)
2010年06月(3)
2010年05月(6)
私の感覚からするとお子さんの誕生はつい先日のような気がするのですが、もうつかまり立ちですか。早いですねー。ウチの息子は就活の真っ最中です。残る楽しみは孫なんですが、孫、できるのかな……。自分自身ものんびりした人生を送ってしまって、就職と同時に家を出たので親からすれば結婚も唐突だっただろうし、子どもの動向が分からないからと愚痴を言ってはいけませんよね。
どこかの校長先生のようなことを言ってしまいますが、お子さんの成長が一番重要だと私は思います。PCなんてそれほど重要ではありません。クイズミリオネアではオーディエンスとかフィフティフィフティ、テレフォンは1回づつですが、実生活では使い放題です。どんどん使いましょう。なかなか仕様を決定してくれないお客様に「ファイナルアンサー？」とか冗談っぽく迫ったりしますが、実はかなり本気です。
仕事でもパソコン触らなきゃ忘れると思いなんとなくカウントダウンタイマーのようなものを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個あり入力するとカウントダウンが始まります時間が来てタイマーが停止したら特定のセルに停止と表示され赤点滅する、というものです。
地震といえば、子どもが保育園に通ってた頃、阪神淡路大震災があったのですが、奥さんの実家が東京だというのでとりあえず避難してきた親子がいました。ほんの数日避難所にいただけでお子さんが虫歯になってしまったそうです。私の子育ての具体的な目標は虫歯ゼロ、正常な視力だったもので、印象に残る体験談でした。
おりがみは伯母が幼稚園の先生だった関係で、研修で学んだというものを復習代わりに私たちに教えてくれたという基礎があります。立体折り紙で代表的なものに薗部式というのがあるのですが、幼稚園児にこんなもの折れるのか？ と、超疑問なものもありましたね。蟻地獄は手順が少なく短時間でできます。おりがみ3枚で作る独楽は御存じですか？ フレーベルの独楽というのですが、写真や動画で教えてくれるものがあります。結構よく回ります。折紙会館とかおりがみハウスで講習会をやっているので、時間が取れると行くのですが、今は全然行けません。
え～っと、
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
ロット番号・停滞日数・経過時間が具体的にどのように記録されているのか（カンマとか改行で区切られているのですか？）一つの棚情報を表すセルは縦並びなのか横並びなのかとかもう少し分かれば具体的に説明できると思います。
ﾛｯﾄNO *********
停滞日数2.2
経過時間12時間
A-1
ﾛｯﾄNO 111111111
停滞日数0.0
経過時間36時間
↑一つの棚情報を表すセルは縦並びです
改行で区切られてます。（二つ製品を置いているイメージ）
ﾛｯﾄが置かれてない状態は空白となります
現在の時刻から停滞日数・時間を出したいです。
大変解りにくい説明で申し訳ありません。。
義母さんお体がすぐれないのですね・・私の母も脚が悪くなって来たので心配です。。父は元気なのですが。。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php
なかなか言葉では難しいですよね・・。
検索ボタンを追加してみました。入力された製品に一致する製品が置いてある棚の一覧がメッセージボックスに表示されます。表示シートの棚の背景色を変えるような処理でもいいかと思いますが、どんな感じがいいでしょうか。と、思ったけどもう検索処理は出来ているのかな。
'棚状態確認
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までって事ですよね？
入出庫は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
表示シートの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の値を変えて調整して下さい。
＜ボタン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 ・・・
ｺｰﾄﾞ入力日ﾛｯﾄ番号 型番 ・・・
ｺｰﾄﾞ入力日ﾛｯﾄ番号 型番 ・・・
ｺｰﾄﾞ入力日ﾛｯﾄ番号 型番 ・・・
：
：
みたいな感じで表示するイメージです。
「入力」シートに抽出結果がこんな感じに表示されているとして。
□|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)というのはダブルクリックしたセルの右側に張り付けてみただけなので、表示したいところに変更して下さい。全然別のシートで実行するならシート名を修飾して下さい。
というSQLは書き方を変えると次のSQLと結果は一緒です。
select 入力日,型番,個数 from [ﾛｯﾄ数集計$]
で、途中に何かカラムを追加したいときは定数（0とか空白とかその他の固定値)を追加します。
select 入力日,型番,'',個数 from [ﾛｯﾄ数集計$]
単価と個数があって金額や消費税を計算したいときは、
select 単価,個数,単価*個数 as 金額,単価*個数*1.08 as 消費税込金額 from テーブル名
みたいな感じです。
突然のコメント失礼します。
ネットで検索しているうちに以前に作成された「競艇トップ10」のファイルを見つけて
コメントさせて頂いてます。
元のVBAがあるから、勉強して加工すれば～とか甘い考えでVBAを勉強しておりますが
まるでわかりませんｗ
項目としては日付・場番号・レース番号・出目・配当金・天気・風速・波高が欲しいのですが、作成していただけないでしょうか？
突然の厚かましいお願いなのですが、よろしくお願いいたします。
倉庫に入れておきましたので、ご確認下さい。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php
お返事が遅くなりました。
突然の無茶振りにも、早急に作成していただき、ありがとうございます。
以前に作成されたものよりも、ややこしそうに見えるのは素人目だからなのでしょうか？ｗ
折角VBAの書籍も購入しましたので
ちょっとずつでも勉強していきたいと思います。
今回の件、誠にありがとうございました。
ファイルのレイアウトを言葉で説明したものが仕様になります。
1行目に「STARTK」がある。
2行目に「KBGN」があり、先頭2桁は場番号である。次の「KBGN」が出てくるまで1開催場のデータ。
3行目は場名、開催日などがある、（開催日はファイル名から編集してますが、ここから参照してもいいですね）
4～28行は今回の処理には不要。
29行目以降はレース情報が12個ある。
レースの先頭判定を「着」の前行としていますが、「1R」の行と判定してしまうと[払戻金]情報の「1R」と紛らわしいから。
レース情報は着順と結果データがある。
結果データは拡連複のみ3行あって、1行目には「拡連複」の文字があるが他行は空白である。
「KBGN」行が出てきたら2行目からの繰り返し。
分かりにくさの原因は、読み込み処理です。
Line Input #intFF, strRECで1行読んだらSplitで空白毎に区切って配列にしているから、単勝と２連単では出目までの空白の数が違うので配列の場所も違ってきます。払戻金に至っては3桁、4桁、5桁とあるのでそれも考慮しないといけません。
しかし、改めてコードを眺めると確かに分かりにくいので少し修正しました。入れ替えておきましたので、参考にして下さい。
ファイルを読んでセルに出力するだけの割には長い処理で「どこが変わったの？」と言われそうですが……。
あげくには、詳細の説明までしていただいて
本当にありがとうございます。
しかし残念ながら、説明は分かり易いのですが
自身のVBA理解度が低すぎて、何が何だか・・・。
ちなみに～なんですが
今回作成して頂いたVBAなんですが
どれぐらいVBAを理解していれば作成出来るものなんでしょうか？
どれぐらい……難しい質問です。
書籍を購入されたなら、取り敢えず一読されることをお勧めします。それから実際に入力して試してみる。プログラムなんて、何か入力してチェックして編集した結果をどこかに書き出すだけです。入力元や出力先に種類があるので複雑に見えますが、OPEN,CLOSE,READ,WRITE,=(代入),+(演算),IF,LOOPと10種類にも満たない命令の組み合わせです。しかし、私の経験ですが、職業で全くの初心者から取り組んで「あ。そーだったのか」的な腑に落ちる瞬間まで半年から9カ月ぐらいかかったでしょうか。まあ、ざっと1000時間ぐらいですよね。これを週末、学習に割ける時間で割ると……。
軽く気が遠くなってきたのではないでしょうか。
一応購入した書籍は１週はしたのですが
な～んとなくの雰囲気ぐらいは掴んだ程度でしょうか？ｗ
1000時間とは・・・一桁多くないですか？って気がしないでもないですね。
仕事で使用する訳でもなく、期限がある訳でもないので
学ぶ喜びを噛み締めながら、コツコツと頑張っていきたいと思います。
はい。確かにプログラムを作れるようになるにはそれほど時間はかかりません。ただ、作れるようになってもなんか違和感があるというか納得できないというか、少し現場を離れると現地での記憶は一切なくなるというか、身についてない感が払拭されるまでに私は平均9ヵ月ぐらいかかるんです。もしかすると他の人はそれほど時間はかからないかもしれません。プログラム言語だけの問題ではなく、振り返ると引越し先で馴染むまでにもそれぐらいかかっていたような気がします。
VBAに関して何か調べようとしたらもうご存じかもしれませんが、私がお世話になっているサイトは「Excelでお仕事」とか「Office TANAKA」です。書籍でいまいち分からないところが納得できたりします。
こんばんわー。
以前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
Range("A2").CopyFromRecordset myRst
の部分の・・・
書き間違いしました。sqlを別ｼｰﾄに抽出しているのがいけないのですかね？？
気になるのは下記の部分です。
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列にするか工夫した方がいいと思います。
えっと、整理しますとｼｰﾄ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
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
ちなみに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のｺｰﾄﾞって出来ますか？？
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
Dim xlBook
Set xlBook = Workbooks.Open("C:\Users\111\Desktop\フォルダ\宿題.xlsm")
また別の話ですがエクセルに入力された値をwebページに直接転記するのを模索しておりましておススメのサイトとかありましたら教えて頂けないでしょうか？？
自分でエサが取れなくなったら、ゾウさんみたいに自らお墓に出向いて死を待つ。ゾウさん偉い。あまりスプラッターなことにならず、自分が実践するにはどうしたらいいか。とか最近お気に入りのテーマです。
さて、下記のマクロを登録して、読み込みたい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
お使いのシステムがパッケージであるとか、カスタマイズが容易ではない場合は仕方ありませんが、もし社内で内製しているようでしたら、今まで手入力で１日何分かかっていたものが、自動入力なら５秒ですよとか提案書を提出してみてもいいのではないでしょうか。風通しの良い会社であれば「あの～。ご相談が……」とお話だけで済むかもしれませんし。手入力だとミスもありますしね。Excelを直接読み込まなかったのは、余計なライブラリを追加しなければならなくて、その承認が取れなかったためです。CSVなどのテキストファイルであればPHPの標準機能で読めます。まずは入力先のシステムが何でできているかの調査ですね。入力項目に日本語があると少し面倒ですが、英数字だけで、データと入力先が単純なキーで１対１ならば１日もあれば追加できる機能であると思います。
だめならば、例のお問い合わせ自動入力マクロをカスタマイズしましょう。
数か月掛けて以前の↑の内容を改善提案を社内のシステム課にしましたが対応してもらえませんでした。。システムはVBベースで作成されております。入力項目は英数字のみでした
ちなみに別件ですがsql文を書く時に重複せず抽出する書き方ってどういう風になりますかgroup by を使うんですよね？たとえば1111というテーブルIDの型番ってカラム名を重複無しで抽出させたい場合です。
せっかく質問してくれたのに、見てなくてすみません。今回、またハズレな案件に関わってます。私は銀のイルカなんですけど（占いの本とか年末に読んだりしません？）今年好調だなんて、ありえないですね。いや。これで好調なんだったら、来年以降が怖い……。四柱推命だと2020、2021が絶不調らしいので、今よりまだ下があるのか？ と慄いてます。今回の案件、新規開拓に行くのが寒いからと、つい横着をして前回と同じ企業で違う部署に横滑りしてしまったのですが、同じハズレな案件でも違う企業に行けば良かったと後悔してます。社食も飽きてきたしなー。B型インフルエンザにもかかってしまったし、新年からあまり良いことはありません。今回の担当者と半年一緒に仕事するのは辛いな～。
どこにどれぐらい処理時間がかかっているか分かるので、一番大きな数字のあたりをじっくり見て下さい。ヒントがあるはずです。インデックス一つで劇的に早くなったりすると楽しいです。
システムの運用で肝心なのは、パスワードが解除されてしまった後、いかに早く察知して対応するかを考えておくことですよね。どの程度の被害が予想されるか、どうしたら回復できるか……。ま、立派なシナリオ作っておいても、何か不具合が出ればいつもバタバタで、とりあえずバックアップを復元して再起動とか、毎度芸がないのですが……。
いつも使うだけで無効にする方法考えたことなかったですね。
「Windows の機能の有効化または無効化」というのはありますが、WindowsAPIとか、ズバリな項目はないですよね。
一般的にExcelとかAccessのVBAだと覗いたり改造されやすいので、どうしても見せたくない機能はTransact-SQLとか(OracleだとPL/SQL)で作ってセキュリティはサーバだのDBに任せるという方向だと思います。
＜やりたい事は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 = "ボタン２" 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に貼り付けようとしたんですがｺｰﾄﾞがイマイチ解りませんでした。
長文で申し訳ありませんがお解りになりますでしょうか？。。
取り敢えずバージョン教えて下さい。
<input type="text" name="1111[]" onChange="doGetData(this,1)">
だとすると、テキストボックスに値がセットされた後、
objIE.Navigate "javascript:doGetData(ie,1111[]);"
のようなコードを入れると検索処理を始めるのではないでしょうか。
ie.Navigate "javascript:doGetData(ie,1111[]);"としてみましたがうまくいきませんでした。。ううむ
<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;//スルーする
ですがﾛｯﾄNOのテキストBOXがie.document.getElementsByName("1111[]")(0)
ie.document.getElementsByName("1111[]")(1)
ie.document.getElementsByName("1111[]")(2)
というVBAのｺｰﾄﾞで上から順にWEBに値だけは入れられるんですが・・・
が参照元って事ですかね？？
"//検索処理*************
function doGetData(obj,lineNo)
//ライン行
obj.lineNo.value=lineNo;"
"
//コマンド
obj.lineNo.Value='select';
obj.action='/@/@/@/ResulutInputServlet';
obj.submit'();
obj.elements['*****'][linNo].focus();
"
********************
doGetData(this.form,1)だったら、
objIE.Navigate "javascript:doGetData(ie.document.forms[0],1);"
かなー？
行番号と言っているのは("1111[]")(0)の(0)の部分のことで、最初の行が0、次が1とカウントアップさせながらobjIE.Navigateしていくんじゃないかなと思います。
ちなみに最初のほうで質問させて頂いたのですが
既に開いている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
ie.Navigate "javascript:doGetData(ie.document.forms[0],1);"としてみたんですが値が入っても実行されませんでした。。
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の方でも何か出てたりしませんか?
Dim pwin As HTMLWindow2
で動きました。普通(?)のインターネット環境では同じコードでもオブジェクトを認識することもできません。何故……。htmlだとかtitleのチェックをしてセルの値をテキストボックスに入力した後、
Set pwin = ie.document.parentWindow
pwin.execScript "doGetData(ie,1)"
のようなコードでjavascript のfunctionが動きました。
Microsoft HTML Object Library
Microsift Internet Control
です。
余談ですが、職場では大丈夫なんですけど、家ではExcelを保存しても次に開くと参照設定が外れてるんですよね。バージョンの違いだとは思うんですけど、これもよく分からない現象です。だから他に選択の余地がある場合はMicrosoftを避けるんですよねー。
function onLoadScript()
//メッセージ
・
・
ってあるので起動時のスクリプトを実行してないからなんですかね？？
pwin.execScript "onLoadScript()"
ie.document.getElementsByName("1111[]")(0).value_=Range("Sheet1!＄B＄2").Value
pwin.execScript "doGetData(ie,1)"みたいな感じで書いてpwin.execScript "doGetData(ie,1)"でエラーが出てますねオンロードのスクリプトはとりあえず実行してみました
objIE.Document.all.JYO.fireEvent ("onchange")
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のセルからテキストボックスに値を代入する処理に変更すれば、実行できそうな気がします。
写真報告書を作成するエクセルのﾂｰﾙを以前拝見しDLして使用させて頂いておりました。
活用させて頂き大変便利でした。この場を借りてお礼を申し上げます。私は半年前から工場に勤務しておりますがエクセルで私自身も何か出来ないか
と思い、少しずつ勉強を始めてみたのですがWEBや書籍でもなかなか実現しそうになかった表の並び替え問題にぶち当たりまして
もしかしたらプロの方ならいい方法がお解りになるのではないかと思いいきなりで大変失礼かと思いましたが
ここで質問させて頂けないでしょうか。また突然の質問ですし、こちらをもしかしたらもう見られて無いかも知れないのでその際はお気にされなくて結構です。
Sheet1に見出しﾌｨｰﾙﾄﾞがA1～J1に[コード]、[コードNo]、[製品番号]、[品名]、[予定日]、[実施日]、[総数]、[タイプ]、[トレーに入れる量]、[トレーの数]とありデータが下に向かって何件も並んでいます。
それを以下の条件で並び替えたいのですがとても複雑で
①[タイプ]は同一種類のみ
②Sheet2に設定した[タイプ]を最優先させる。設定が無ければスルーする
③[トレーの数]のデータの値が↓のセルに向かって合算で30になる（一つ一つのﾃﾞｰﾀのトレーの数はﾊﾞﾗﾊﾞﾗで30を超過しない1～29枚の範囲）
④[予定日]が早い順にならびかえ
⑤[実施日]が現時点の時刻より10日以上経過しそう(8日～9日)なら予定日より優先され繰り上げて優先される（でもトレーの数は合算で30以上超過しないように）
⑥並び変えたデータの集団のセルが色が変わる
※オプションボタンでトレー数変更切り替え設定→80枚設定
というような感じです。上手く説明出来なかったかも知れませんが上記内容でご理解頂いてお力を頂けたら大変助かります。突然の書き込みで申し訳ございません。
ちなみにエクセル2010～のバージョンです。
http://chobi2dataland.sblo.jp/article/165654052.html