2011年04月20日

にじいろ あおむし

P1000457.JPG
posted by ちょびちょび at 10:02| Comment(69) | TrackBack(0) | 日記
この記事へのコメント
以前のBETWEENが正常に動くようでしたら、この応用で7日前、10日前を判定しましょう。
WHERE 日付のカラム名 BETWEEN TO_DATE('" & TextBox1 & "', 'YYYY/MM/DD') AND TO_DATE('" & TextBox2 & "', 'YYYY/MM/DD')

Dim date7 As Date
Dim date10 As Date
date7 = Format(Now() - 7, "yyyy/mm/dd")
date10 = Format(Now() - 10, "yyyy/mm/dd")

WHERE 日付のカラム名 >= TO_DATE('" & date7 & "', 'YYYY/MM/DD')

また、3種類のSQLがあってそれを切り替えたいときは、こんな感じです。
Sub Macro1()
Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
strSQL1 = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文1"
strSQL2 = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文2"
strSQL3 = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文3"
If Sheet1.OptionButton1.Value = True Then
strSQL = strSQL1
End If
If Sheet1.OptionButton2.Value = True Then
strSQL = strSQL2
End If
If Sheet1.OptionButton3.Value = True Then
strSQL = strSQL3
End If
myrst.Open Source:=strSQL, ActiveConnection:=mycon
End Sub

もうちょっとプログラムっぽく書くとこんな感じ。
Sub Macro2()
Dim strSQL As String
Dim arySQL(2) As String
Dim i As Integer
arySQL(0) = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文1"
arySQL(1) = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文2"
arySQL(2) = "SELECT 抽出内容1,抽出内容2 FROM テーブル名 条件文3"
For i = 1 To 3
If Sheet1.OLEObjects("OptionButton" & i).Object Then
strSQL = arySQL(i - 1)
Exit For
End If
Next
myrst.Open Source:=strSQL, ActiveConnection:=mycon
End Sub

この書き方はオプションボタンがシート上に配置されているときで、ユーザーフォームだと少し違います。

大量データの件はまた後ほど。メモリの件ですが、バグだそうで、回避方法としては処理の区切りのいいところでブックを閉じてあげるとかそんなことしか書いてないですねー。xlsxだと同じことをしても大丈夫なんです。
Posted by ちょびちょび at 2013年08月15日 12:11
お世話になります((。´・ω・)。´_ _))ペコ
お休みのところ回答頂き大変ありがとうございます。
「応用で7日前、10日前」と「SQL文を切り替え」は明日出勤なのでコードを試してみたいと思います!

<メモリの件ですが、バグだそうで、回避方法としては処理の区切りのいいところでブックを閉じて・・
これはバグなんですね〜。。|ι´Д`|っ 
処理の区切りがいいところだと
myRS.Open "[伝票一覧$]", myCon
の後かレコードセット").CopyFromRecordset myRS
の後ら辺で参照BOOKを閉じる感じでやってみます。

Posted by takoyakiudon at 2013年08月16日 10:25
テキストボックスから指定したLotbフ前後5件を表示してみましたが、こんな感じでしょうか。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php
Posted by ちょびちょび at 2013年08月17日 00:16
お世話になります!対応ありがとうございます!!((。´・ω・)。´_ _))ペコ
上記リンクに飛んでZIPを解凍してみましたが解凍後3つのフォルダー(rels、docProps、xl)がDLされて([ContentTypes]xmlドキュメントとか)エクセルBOOKは見当たりませんでした。これはうまく解凍出来て無いのでしょうか??(・ω・ )??
Posted by takoyakiudon at 2013年08月17日 05:55
不具合申し訳ありません。
取りあえず、Fierfoxだと正常にダウンロードできます。IE以外のブラウザをすぐ使える状態ならそれでお試しください。また、拡張子zipをxlsmに変えても開けるようになると思います。
Posted by ちょびちょび at 2013年08月17日 07:49
申し訳ありません。。Fierfoxって勉強不足で知らないのですが何の事でしょうか・・。(゚Д゚≡゚Д゚)?
Posted by takoyakiudon at 2013年08月17日 13:48
ネットで調べたんですがダウンロードして使用する解凍ソフト、って感じでしょうか?
Posted by takoyakiudon at 2013年08月17日 15:19
重ね重ね、すみません。Firefoxです。IE以外なら多分どのブラウザでも大丈夫です。
Posted by ちょびちょび at 2013年08月17日 16:50
お世話になります。

Cドライブの空きが無いのが原因なのかPC環境が悪いのかDL出来ませんでした・・。
何か別の方法ってございませんでしょうか??

SQL文の切り替えは無事うまくいきました!ありがとうございます!

7日前、10日前、期間検索(任意で入力)の日付の切り替えはオプションボタンを使ったSQL文切り替えを参考にしてやってみたのですが・・・BETWEEN TO_DATEしか反応せずうまく出来ませんでした。。
WHERE 日付のカラム名 BETWEEN TO_DATE('" & TextBox1 & "', 'YYYY/MM/DD') AND TO_DATE('" & TextBox2 & "', 'YYYY/MM/DD')と
Dim date7 As Date
Dim date10 As Date
date7 = Format(Now() - 7, "yyyy/mm/dd")
date10 = Format(Now() - 10, "yyyy/mm/dd")
オプションボタンをこれも3つ配置して切り替えたいですが↑wereの後どのようにコードを書いたらよいでしょうか?
お手数ですがご教授願います。
Posted by takoyakiudon at 2013年08月18日 10:39
WHERE後の書き方はこんな感じですね。

WHERE 日付のカラム名 >= TO_DATE('" & date7 & "', 'YYYY/MM/DD')"

TextBox1とdate7の中身を調べて同じ形式かどうか確認してみて下さい。もしかしたら、
WHERE 日付のカラム名 >= '" & date7 & "'" で大丈夫かもしれません。なんでしたら、BETWEENのままdate7の00:00:00から23:59:59という方法でもいいかもしれません。

ダウンロードの件ですが、2003形式にして入れ替えました。再度お試し下さい。 
Posted by ちょびちょび at 2013年08月18日 12:59
DLですがバッチシ確認できました!(≧∇≦)b
イメージ通りの思ってた動作です。
これを元にデータを正規のもので試してみます!!
日付の件もありがとうございます!
これを参考にして改めて挑戦してみます!
お休みのところ大変ありがとうございました!!
頑張ります!
Posted by takoyakiudon at 2013年08月18日 14:20
お世話になります((。´・ω・)。´_ _))ペコ
先日DLさせていただいた「連続5件抽出」は職場で活躍しております。使っていて( ゚д゚)ハッ!
と最初に質問させて頂いた時に思い付かなかった点がありもし可能でしたらアドバイスお願いします。
データの集まりの先頭に(各工程ごとに)
A1
工程 ロット 完了日付 完了時間 製造場 作業者CD 作業者名 タイプ 特性 容量 季節 配送 出荷物仕様 設備 g寸 原料 仕掛工程
A2洗い場経歴 aaaaaaaa 2013/8/5 08:04:52 M 1112550 TAKOYAKI ggggggg B qqq w 50 njin 000 1.6 リンゴ 出荷
A3過不足 ロット 完了日付 完了時間 製造場 作業者CD 作業者名 タイプ 特性 容量 季節 配送 出荷物仕様 設備 g寸 原料 仕掛工程
と実際に最初のデータはA4から洗い場のデータの経歴が↓に向かって始まってます。(工程が変わるごとに↑のようにサンドイッチになります。)
別シートのタイトル名を付与してSQL抽出した内容をサンドイッチにしてタイトルのようにして以下データを表示させているツールです。(ロットNOをキーにして経歴を各工程ごとに抽出するもの)データは全部で10000件以上あり先日の連続5件抽出するツールでずいぶん纏めるのが楽になったのですがタイトルとsqlで抽出したサンドイッチのデータのロットNOを無視した連続5件って出来ますか?工程が40近くあるので工程が変わる事にサンドされたデータの中にロットnoがあり前の工程の最後ら辺の前後ではないデータを前後5件として認識しないように出来たら素敵なんですが・・。解かりにくい文で申し訳ありません。よろしくお願い致します。
Posted by takoyakiudon at 2013年08月26日 13:20
おはようございます。
「特定のデータを無視したい=抽出しない」です。除外したいデータとその他のデータの違いは何ですか? 例えば先頭カラムの先頭文字が「A」のものを除外したかったら抽出条件に「substr(先頭カラム, 1, 1) != 'A'」(これはoracleの書き方。VBAだとmid)とか書いて処理を行います。VBAの方だったら行数を数えるところで条件文を追加して無視したい行をスキップする、とかです。
Posted by ちょびちょび at 2013年08月28日 07:22
お世話になります((。´・ω・)。´_ _))ペコ
何だか頭がボケボケしていて良く解かんない質問をしてしまい申し訳ありません。。

<「特定のデータを無視したい=抽出しない」です〜
頭を整理してみたらSQLで関係ない項目抽出しなければうまくいくじゃん、って事に気付けませんでした。。ちょっと元のツールをいじって対応したいと思います。。
除外したいデータとその他のデータの違いは何ですか? との事ですが元々のツールがロットnoをキーとして混入があったかどうかを調べる加工経歴一覧を表示するツールみたいなものです。加工経歴が2日分くらい加工完了時間順に工程ごとにSQLで抽出されるものでその調べる対象のロットnoの加工完了時間が近いものだけ抽出されれば良いのですが2日分くらい抽出されるのでデータを後で纏める必要があったのです。除外したいデータというのは工程毎に○○工程ロットnoと親切?にタイトルが付けられる様になっていてそのタイトル部分(ロットNO)が「前後5件」ツールに要らないデータなんですがSQLいじればどうにかなりそうですのでちょっと頑張ってみます。
本当はそのBOOKごとお見せ出来れば話が早かったんですが・・(;^ω^)
でもそれ無しにしても「前後5件」かなり役に立ってます!ありがとうございます。
別件の質問で恐縮ですがエクセルのシートD8から5文字くらいの文字が手入力されて全部で500行くらいあるデータがありますがそれを手入力で変更したら変更した隣のE列に自動で同じ内容になるコードってありますか?=D8とかでなくVBAです。Worksheet_Changeとかで出来そうな気がしましたが・・。自分でも勉強しているのですが思い通り行かなくて・・。よろしくお願いします。。
Posted by takoyakiudon at 2013年08月29日 05:19
いえいえ。伝えようと思って頑張って書いてみると考えが整理されることもあるし、申し訳ないことなんてありません。Officeユーザーなんて沢山いるはずなんですが、意外とVBA職人とは遭遇しません。きっと takoyakiudonさんもVBAに関して孤独を感じることがあったりするんじゃないかなーと思ったりしています。ExcelにできることはExcelに極力任せて、人間じゃないとできない本来の作業に時間がかけられるよう、お互い頑張りましょう。

D列に何か入力したらE列にも同じ内容が入力されるコードはこんな感じです。
If Target.Column = 4 というのがポイントです。このIfがないとEセルに値がセットされてイベントが発生してF列にセットされF列でイベントが……と恐ろしいことになります。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
Cells(Target.row, Target.Column + 1) = Cells(Target.row, Target.Column)
End If
End Sub
Posted by ちょびちょび at 2013年08月29日 23:13
お世話になります((。´・ω・)。´_ _))ペコ
回答ありがとうございます。助かります。
人手が無いのにデータ管理が多く仰る通り毎日PCと格闘しております。本当に非常に助かっております!恐縮ですがまたまた質問です。
以下のようなデータがあります。セルB8から始まるCH8まで横並びのデータがあります。それが300行くらいあるのですがD列以外は先月のデータです。生産計画からD列に毎月データをコピーして貼り付けるのですがD8からD300にはAA447のような5桁データを貼り付けます。E列に同じ項目の5桁データがありますがD列に貼り付けたデータが同じ(完全一致)だったらそのままの状態で保持しもし違うデータ(例えばAAAA3とか)だったらセルB8からCH8の範囲で空欄行を挿入したいです。。お忙しいと思いますがコードを教えて頂きたいです。よろしくお願いします((。´・ω・)。´_ _))ペコ
Y たこやき工場 AA447 AA447 0.750 22.500 1.50 ミカン 118.881 - 0 - - 2200 2400 160 固め 1.25 1.65 199 4 50 A25 7 30 6 11 0.25 W68 34 0 0.28 0.30 BWS60 0 11.05 SS-3・4 400 200 185 170 10.76 40 140 0.05 0.03
説明下手ですがよろしくお願い致します。。
Posted by takoyakiudon at 2013年08月30日 04:19
お世話になります((。´・ω・)。´_ _))ペコ
本日は私の子供が急病な為会社をお休みし看病しんがら昨日朝方質問させて頂いた内容をあれこれ自分で試して見ました。(D列に貼り付けたデータが同じ(完全一致)だったらそのままの状態で保持しもし違うデータ(例えばAAAA3とか)だったらセルB8からCH8の範囲で空欄行を挿入)試してみた結果このコードが一番思っていた状態に近くて空欄が見事に挿入されますがちょっとおまけを加えて挿入された空欄D列に貼り付けた違うデータがずれ込んで入る、ってのは不可能でしょうか?

Sub 左右不一致()
  Dim maxrow As Long
Dim i As Long
maxrow = Cells(Rows.Count, 8).End(xlUp).Row
For i = maxrow To 1 Step -1
If Cells(i, 4) <> Cells(i, 5) Then
Rows(i).Insert
End If
Next i
End Sub
下記がイメージですが・・。
D  E 
AA447AAAA3
↑マクロ実行前(D列に貼り付けE列と同じだったら何もしない)

D  E 
・・・・・・・・
AA447AAAA3
↑マクロ実行後空欄行挿入(・・は空欄)

D  E 
AA447・・・
AAAA3AAAA3
↑出来た空欄に貼り付けした違うデータが入って元々同じだったE列のデータがD列に挿入・・


Posted by takoyakiudon at 2013年08月31日 01:33
変数を一つ増やして、Insert前にDの値を退避し、Insert後に戻してあげればよいかと思います。
Dim maxrow As Long
Dim i As Long
Dim DValue As String
maxrow = Cells(Rows.Count, 8).End(xlUp).Row
For i = maxrow To 1 Step -1
If Cells(i, 4) <> Cells(i, 5) Then
DValue = Cells(i, 4)
Rows(i).Insert
Cells(i, 4) = DValue
End If
Next i

おお。何だか私の数年前までと似た時間帯で生活していらっしゃるようだな―と思っていましたが、人生で一番忙しい時期を頑張っておられるのですね。今振り返ると子育てには反省点ばかりなのですが、まあ、私の実力だとこれが精一杯だし! とか開き直っています。現在も仕事はしていますが、仕事より会社の観察に行く感じで、現役時代には縁のなかったベンチャー企業など興味深いです。あと何社お邪魔できるか、コーディネーターさんに迷惑な記録の更新に挑戦中です。
Posted by ちょびちょび at 2013年08月31日 10:27
お世話になります((。´・ω・)。´_ _))ペコ
早速の回答ありがとうございます!VBA触り始めてからいつも思うのですがプログラムってすごいな〜と思ってしまいます。
D  E 
AA447・・・
AA447AAAA3
思っていた動作にほぼ近いのです!挿入された空欄にDValue = Cells(i, 4)でデータ入れた後Cells(i, 4)=Cells(i, 5)ってやりたいのでこれも変数にしてやれば可能っぽいですね〜
D  E 
AA447・・・
AAAA3AAAA3
ちょっとやってみます。
ちょびちょび さんは以前のブログUP内容などから察すると管理職のような感じなのですね〜。
私は現在交代勤務をしておりまして仕事する時間帯がバラバラなのですっかり体内時計が狂いまくった生活をしています。通常作業を行う傍らVBAを触ってますが中々手探りではどうする事も出来ない時があり(マクロの記録や自分の知識だけでは対応出来ない)ので自分でも本やネットで調べたりしますがなかなか上手く情報を得られない事が多いので非常に助かってます。一応社内にもIEの部署があってVBAなど専門の方が居られますが他部門で接点が無くまた依頼・質問するにしても結構な手続きが必要で時間掛かってやりにくいです。。
知恵袋など拝見してますとよくマスターの方が自分で勉強したり調べればいいじゃん、的なかなり冷たい回答されてますが質問者の状況によってはなかなか出来ませんよね、きっと(勉強出来る環境でないとか結果がすぐ必要だとか、それこそプライベートが子育てや介護で時間が無いとか)何か以前知恵袋でどなたかも書いてたんですが質問して良かった、って思える時と質問しなければ良かったと思う残念な時があるってのを観ました。おそらくその方は私と同じような環境のような気がしたんですが・・。まあ中には全く勉強する気も無い方も少なからずおられると思うのでマスターの書かれた事も解かんなくも無いですが(´・ω・`)
Posted by takoyakiudon at 2013年08月31日 14:45
お世話になります((。´・ω・)。´_ _))ペコ
今日一日子供の面倒を見ながら考えてみて無事結果を出す事が出来ました。同一のサブルーチン内だとうまく動かなかったので新たにサブルーチンを設けENDSUbの前にCallして右側に合わせるといった力技でしたが・・。(最初のサブは教えて頂いたもの↓はcallするもの)
If Cells(i, 5) <> "" And Cells(i, 4) <> Cells(i, 5) Then
Cells(i, 4).Value = Cells(i, 5)
ちなみにシートが8行目B8からCH8列から始まって下にデータが続いてるんですが(A1:CH7にはタイトルや備考など入っている)これらにも空欄が挿入されてしまいますのでこれらの範囲について空欄挿入って無視出来ますでしょうか??(・ω・ )??
Posted by takoyakiudon at 2013年09月01日 02:00
Cells(i, 4) とか Cells(i, 5) の i 部分が行ですから insert文に判定を入れて

If i > 7 Then
Rows(i).Insert
End If

みたいな感じでしょうか。
Posted by ちょびちょび at 2013年09月01日 14:50
If Cells(i, 5) <> "" And Cells(i, 4) <> Cells(i, 5) AND i > 7 Then とコードを記入して無事上手くいきました!ありがとうございました!
先月の17日くらいにADOでパスワード付きのBOOKにアクセスしシート内容を転記する件で質問させて頂きました。
<メモリの件ですが、バグだそうで、回避方法としては処理の区切りのいいところでブックを閉じて・・
であれからずいぶん構ってみましたがバグ?が治らずどの場所でBOOKを閉じても参照先の必要の無いマクロとシートが残ってしまいます・・。(´・ω・`)
(閉じると消えてますがPCメモリが足らないエラー表示がたまに出ます)
ちょっと自分でやっていたADOを諦めようかな、って考えてるんですが別BOOKにあるパスワード付きのBOOKのシートの内容をマクロで取り込む方法ってございますか?ちなみに参照先のBOOKのシートはフィルター掛かってる事があるので単純にコピーだと全件データを持って来れない感じです。
Posted by takoyakiudon at 2013年09月02日 13:20
こんばんは。今週(今日は日曜だから先週かな)も金曜日の23時とかいう非常識な時間に休日出勤が決まってしまいました。会社からの評価より、地元での信用の方が大切です。なんとかしないと。

Excel形式(.xlsxとか.xlsmのやつ)だとダウンロードできないとのことだったので、97-2003形式でパスワード付きのファイルを読んでみましたが、何か勝手にマクロが増えていたり、実行後メニューバーがどこをクリックしても反応しなくなったり、お手上げです。.xlsmだと同じコードで問題なく読めます。
メモリが解放されない件は、もしかしたらForとかWhile文の途中(といってもNextとかWendの直前が妥当でしょうか)にDoEventsを入れてあげると改善するかもしれません。
Posted by ちょびちょび at 2013年09月08日 22:02
お世話になります((。´・ω・)。´_ _))ペコ
お忙しい中回答ありがとうございます。金曜日の23時からとかハードでしたね・・。

あれから色々やってみましたがうまくいかず仕方ないので参照BOOKを読み取りで開いてフィルター解除してコピー、取り込み先のBOOKに貼付けのマクロを組みました・・。ADOではロック掛かったBOOKの内容取り込むのは向かないのでしょうね。。
まあSQLをそのBOOKでやらないので単純にシートの内容取得だったら単純な方が良いかなと思いました。ちなみに先日の連続5件のコードですがシートの左側のデータ(参照する方です)を直接連続5件にしてしまう事出来ますか?イメージとしては空欄を削除したり重複データを削除するコードのイメージで。ロットNOはテキストBOXやインプットBOXで指定してマクロ実行みたいな。
というのも連続5件表示させたデータをコピーして違うブックやシートに貼り付けたいって要望が同僚から出まして単純にそのままコピーすると関数だけ貼付られてしまいますよね?データを他の用途でも使いたいかららしいのですがとても変な質問で申し訳ありませんがもし可能でしたらよろしくお願い致します。
Posted by takoyakiudon at 2013年09月09日 22:16
こんばんは。
コピーして貼り付けるとき、メニューバーの「編集」⇒「形式を選択して貼り付け」⇒貼り付けの「値」をチェック、演算の「しない」をチェックして「OK」すると値が貼り付きますよ。この処理をマクロに追加してもいいですし。参照元はあまり変更しない方がよいと思います。処理結果になんとなく違和感を感じたときにすぐチェックができないとか、そんな理由です。
Posted by ちょびちょび at 2013年09月09日 23:22
回答ありがとうございます!そういえばそういう事が出来るって忘れておりました・・・。
この処理をマクロで組んでやってみます。自動マクロで組めそうですが抽出件数が定まってない場合は範囲の指定が適当になってしまうのですがデータが空欄になるセル範囲をマクロで指定する場合どのようなコードになりますか?
Posted by takoyakiudon at 2013年09月12日 11:49
セルにところどころ適当に値を入れて実行してみて下さい。

Sub Macro1()
Dim oRange As Range
Dim lColumnL As Long '最左列
Dim lColumnR As Long '最右列
Dim lRowT As Long '開始行
Dim lRowB As Long '最終行
Set oRange = ActiveSheet.UsedRange
lRowT = oRange.Row
lRowB = oRange.Row + oRange.Rows.Count - 1
lColumnL = oRange.Column
lColumnR = oRange.Column + oRange.Columns.Count - 1
MsgBox "最右列は : " & lColumnR
MsgBox "最終行は : " & lRowB
MsgBox "最左列は : " & lColumnL
MsgBox "開始行は : " & lRowT
End Sub
Posted by ちょびちょび at 2013年09月12日 22:00
お世話になります((。´・ω・)。´_ _))ペコ
すっかり涼しくなりました。うちの子供もよく風邪を引いて保育園から呼び出しが来て何だか仕事も忙しい上にバタバタした毎日を送っております。
↓のようなコードで抽出条件ロットnoのカラム名にしセルの場所(例えばB5とか)に10桁のロットNOに入力しSQL実行で抽出する事が出来ました。ただB6〜↓に向かって一件だけでなくセルにロットno入力した分だけ処理したいのですがDO〜LOOPかアンティルでセルが空欄になるまで繰り返し実行したいのですが本など参考にしながらやってみましたがうまくいきませんでした。。コードに処理を書く場所もおかしかったと思いますがちょびさんならどの様にされますか??またSQLの部分を縦に記載したいのですが例えば
s_sql=""
s_sql=SELECT 抽出内容1・・みたいな
・・なんか上手くいきませんでした。。
Option Explicit
Sub F_Sample059()
'Microsoft ActiveX Data Objects 2.0以上 参照設定
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim i As Long
'接続先サーバーを指定する
myCon.Open ConnectionString:= _
"Provider=MSDAORA;Data Source=WGS_IMF00109-NTS_ORCL;User ID=※※; Password=※※;"
'SQL
myRst.Open Source:="SELECT 抽出内容1,抽出内容2 FROM テーブル名", ActiveConnection:=myCon
Worksheets.Add
With myRst
'フィールド名
For i = 1 To .Fields.Count
Cells(1, i).Value = .Fields(i - 1).Name
Next
'レコード
Range("A2").CopyFromRecordset myRst
.Close
End With
myCon.Close
Set myRst = Nothing 'オブジェクトの解放
Set myCon = Nothing
End Sub


Posted by takoyakiudon at 2013年10月16日 14:46
こんばんは。保育園時代は苦労しますが、ここでいろいろな免疫が獲得できますので、小学校ではかなり丈夫な児童として過ごせますよー。
さて、縦に記述したいとのことですが、こんな感じでしょうか。
s_sql = ""
s_sql = s_sql & "SELECT 抽出内容1"
s_sql = s_sql & " FROM テーブル名"
接続文字を使う場合はこんな感じです。
s_sql = "SELECT 抽出内容1" & _
" FROM テーブル名 " & _
" WHERE ロットNO = '" & 1111 & "'"

B6から下に向かって判定するのはこんな感じです。
i = 6
Do While Cells(i, 2) <> ""
msg = Cells(i, 2)
i = i + 1
Loop
Cells(i, 2) <> "" のところを先に最終行を求めて i <= 最終行 にしてもいいですし。msg = Cells(i, 2) の行をアレンジしてsqlを発行するなり計算するなりして処理を行って下さい。


Posted by ちょびちょび at 2013年10月20日 20:47
お世話になります。((。´・ω・)。´_ _))ペコ
アベノミクスの影響か解かりませんが仕事はここ近年にないくらい多忙な日々を過ごしています。
色々試している最中なのですが
先日アドバイス頂いた件を仕事の傍ら試しているのですがmyRst.Open Source:="SELECT 抽出内容1,抽出内容2 FROM テーブル名", ActiveConnection:=myCon
のmyRst、myConの記述のせいなのか
s_sql = ""
s_sql = s_sql & "SELECT 抽出内容1"
s_sql = s_sql & " FROM テーブル名"
のように記述するとエラーになってしまいます。。



あと普通に縦に記述している別のツールでmainというシートにテキストBOXを2つ配置して期間検索をかけたいですが
日付のカラム名BETWEEN TO_DATE('" & Sheets("main").TextBox1 & "', 'YYYY/MM/DD') AND TO_DATE('" & Sheets("main").TextBox2 & "', 'YYYY/MM/DD')",と記述すると記述が長いみたいな内容のエラーとなってしまいます。


実際のSQL文は↓のような感じです
sSql = ""
sSql = sSql & "SELECT         カラム1.アアアア, "
sSql = sSql & " カラム1.うううう, "
sSql = sSql & " カラム1.ええええ, "
sSql = sSql & " REPLACE(カラム1.おおおお, ' ', ''), "
sSql = sSql & " カラム1.kkkk, "
sSql = sSql & " カラム3.しししし, "
sSql = sSql & " カラム1.きききき, "
sSql = sSql & " カラム1.くくくく, "
sSql = sSql & " カラム1.けけけけ, "
sSql = sSql & " カラム1.ここここ, "
sSql = sSql & " カラム2.ああああ, "
sSql = sSql & " CASE "
sSql = sSql & " WHEN カラム2.いいいい= 'S' THEN カラム2.うううう"
sSql = sSql & " Else ' ' "
sSql = sSql & " END, "
sSql = sSql & " カラム3.ええええ"
sSql = sSql & " FROM カラム1, "
sSql = sSql & " EPRASS.カラム2, "
sSql = sSql & " EPRASS.カラム3"
sSql = sSql & " WHERE カラム1.いいいい= カラム3.いいいい"
sSql = sSql & " AND カラム1.おおおお= カラム3.けけけけ(+) "
sSql = sSql & " AND FMSカラム10001.おおおおお= 'Y'"
sSql = sSql & " AND NOT(カラム1.ふふふふ= 'ZZZZ') "
日付のカラム名BETWEEN TO_DATE('" & Sheets("main").TextBox1 & "', 'YYYY/MM/DD') AND TO_DATE('" & Sheets("main").TextBox2 & "', 'YYYY/MM/DD')"

記述の仕方がおかしいと思うのですがどうしたらよいでしょうか??
Posted by takoyakiudon at 2013年10月27日 21:37
myRst.Open Source:="SELECT 抽出内容1,抽出内容2 FROM テーブル名", ActiveConnection:=myCon

上の行のSQL部分を別に編集したい、というご要望でしたら、下記のような感じになると思います。

s_sql = ""
s_sql = s_sql & "SELECT 抽出内容1"
s_sql = s_sql & " FROM テーブル名"
myRst.Open Source:=s_sql, ActiveConnection:=myCon

「エラーになる」は詳細なメッセージがないと最適なアドバイスできませんので、今度出たらコピーして貼り付けて下さい。

「記述が長いみたいな内容のエラー」は多分
sSql = sSql & " FROM カラム1, "
sSql = sSql & " EPRASS.カラム2, "
sSql = sSql & " EPRASS.カラム3"
あたりの文法的な問題だと思います。「EPRASS.カラム2」がピリオドも含めてテーブル名だとすると[]で囲まないと叱られます。
ピリオドがあっていいのはテーブル名とカラム名の区切りで、名称自体に特殊な文字が含まれているときは[]で囲みます。
EPRASSがテーブル名だとするとFROM句の書き方に問題が生じます。あと、(+)の書き方はOracleだけかと思います。DBはOracleでしたっけ? Oracleなら問題ないかと思いますが、inner join の方がSQLの世界では一般的かと思います。

TBL1,TBL2が等結合だと
FROM TBL1 inner join TBL2 on TBL1.COL1 = TBL2.COL1 みたいな書き方になります。
TBL1、TBL2が外部結合の場合は
FROM TBL1 left join TBL2 on TBL1.COL1 = TBL2.COL1 (TBL1が全部)とか
FROM TBL1 right join TBL2 on TBL1.COL1 = TBL2.COL1 (TBL2が全部)になります。

TBL1、TBL2、TBL3と沢山あったら、TBL1とTBL2の関係、TBL1とTBL3の関係、(あったら)TBL2とTBL3の関係というように全部記述しないといけません。
FROM TBL1 inner join TBL2 on TBL1.COL1 = TBL2.COL1
TBL1 inner join TBL3 on TBL1.COL2 = TBL3.COL1

SQLの学習法ですが、もし可能ならCSEとかDBに接続できる無料ツールをインストールするのが望ましいかと思います。SQLを書いて実行するとすぐ結果が表示(ダメな場合はエラーメッセージですが)されるので、VBAの文法的なミスかSQLに問題があるかの切り分けがしやすいです。
Posted by ちょびちょび at 2013年10月28日 23:41
お世話になります。
((。´・ω・)。´_ _))ペコ
BETWEEN TO_DATE('" & Sheets("m・・・のあとに「"」がコピ-した際になぜか2つ付いておりました。。どうやらそれが悪さをしておりエラーとなったようです。
SQLの無料ツールがあるのですね。ちょっと時間がある時に勉強がてらやってみようかと思います。
外部結合にも色々あるのですね。回答頂いた通りODBC経由などでしたらinner join になりますよね?クエリーでsqlを表示させたら記述がありました。大変参考になりました。外部データベースの接続はオラクルを使用してます。
eprassの記述ですが私が質問書く際に消し忘れてました。本当は全てeprass.込みのテーブル名です。

大変役に立つ回答でした。ありがとうございます!
あとよくWIN32?でしたっけAPIとかよく聞くのですがあれってどういう物なんでしょうか?
本などでC言語の・・とかOSの機能を使う・・とか書いてあったような気がしますが確かちょびさんが作成された報告書作成補助ツールにも使用されていたような気がしましたが・・勘違いでしたらすいません。
Posted by takoyakiudon at 2013年10月31日 14:15
こんにちは。ちょっとでも参考になればうれしいです。「書き込む」を押した後で「ちょっと違うこと言っちゃったかな……」みたいな不安がいつもあります。

APIというのは言語に関係なく全てのプログラムに共通のお道具箱みたいなものです。ボタンやアイコンをクリックすると何かウィンドウが開いたりしますよね。それをCでもVBAでもと一々開発するのは効率的でないので、どのプログラムでも使う機能は共通化してあるんです。例えばRaceTop10v3.xlsのフォルダを選択するボタンはSHELL32.dllに定義されているSHGetPathFromIDListというAPIを使ってフォルダ選択画面を表示させてます。他にもUser32.dllとかKernel32.dllなどがあって、Get〜という関数を使うと色々な情報が取得できます。一覧を眺めているだけでも、なんとなくコンピュータがやっている(できる)お仕事の理解が深まるかと思います。
Posted by ちょびちょび at 2013年11月03日 12:21
お世話になります((。´・ω・)。´_ _))ペコ
連休を利用して神戸のアンハ○ンマンミュージアムに娘を連れて行って来ました。一昨年高知のミュージアムには連れて行きましたがまた趣きが違って満足したようです。
あとxpがサポート終了してしまう為大阪梅田にてPCを新たに新調してかなり散財してしまいました。
15年振りくらいに梅田に行きましたがすっかり街が変わっており当時住んでいた私が知っている梅田ではありませんでした。(;^ω^)アハハ

APIを覚えるというか使える様になるにはどういった学習方法が良いのでしょう?ネットでちらっと観た程度ですがC言語が解かってないと素人が手を出すとろくな事にならない、みたいな内容が記載されてました。。


質問し忘れていたのですがWHERE句の事で
テキストBOX3を追加で設置し設備名が選択されていればその設備の内容を抽出し設備名が選ばれなかった場合全件抽出としたいのですがどのように記述したらよいのでしょうか?現在はとりあえず設備を選んで抽出出来る様にはしてあります。
WHERE 日付のカラム名 BETWEEN TO_DATE('" & TextBox1 & "', 'YYYY/MM/DD') AND TO_DATE('" & TextBox2 & "', 'YYYY/MM/DD') AND 設備のカラム名('" & TextBox3 & "', '') 会社PCに入ってるので確認出来ませんがこんな感じ記述してたと思います
Posted by takoyakiudon at 2013年11月05日 14:29
Sub Macro1()
Dim strSQL As String
Dim strCond As String
strSQL = ""
strCond = ""
strSQL = "select * from TBL "
If Trim(TextBox1) <> "" Then
strCond = strCond & "日付=" & Trim(TextBox1)
End If
If Trim(TextBox2) <> "" Then
If strCond <> "" Then
strCond = strCond & " and "
End If
strCond = strCond & "所属=" & Trim(TextBox2)
End If
If strCond <> "" Then
strSQL = " where " & strCond
End If
End Sub

TextBox1が日付でTextBox2が部とか課のコードだとします。
必ず指定されるのであればSQLは1行で書けますが、入ってるかどうかも分からない。どちらかだけ入ってるかもしれない、となると上のコードのように非常に面倒な判断が入ります。その他に集計とか並び替えなども指定したいという場合もありますよね。If strCond <> "" のところは If Len(strCond) > 0 (strCondの長さが0より大きかったら)みたいな書き方を好む人もいます。Trim(TextBox1)は人が入力する場合、もしかしたら後ろに余計な空白があるかもしれない、とか疑ってTrim(空白除去)を付けます。もっと丁寧に書けば処理を始める前に
If IsDate(TextBox1) = False Then
MsgBox ("日付を入力して下さい。")
Exit Sub
End If
とか入れてあげるとより親切ですね。
コンピュータは代入、加算、分岐しかできません。システムの作成は分岐条件の洗い出しが主な業務です。どんな大きなシステムでも同じです。Cが現在分かっていなくてもtakoyakiudonさんだったらAPIの習得は大丈夫です。週末にでも何かサンプルアップしておきますね。
Posted by ちょびちょび at 2013年11月06日 07:51
お世話になります((。´・ω・)。´_ _))ペコ
大変解かりやすい回答ありがとうございます。
助かります。

別件で勉強したいのですが以下のマクロを組みました。↓

Sub クエリ実行()
v = 4
Do
Cells(2, 1) = v
If Right(Sheets("入出画面").Cells(v, 5), 1) = "0" Then
Sheets("work").Cells(2, 3) = Sheets("main").Cells(v, 5)
Sheets("work").QueryTables(1).Refresh BackgroundQuery:=False
Sheets("work4").QueryTables(1).Refresh BackgroundQuery:=False
Sheets("main").Cells(v, 6) = Sheets("work").Cells(6, 4)
Sheets("main").Cells(v, 7) = Sheets("work").Cells(6, 5)
Sheets("main").Cells(v, 8) = Sheets("work").Cells(6, 7)
Sheets("main").Cells(v, 9) = Sheets("work").Cells(6, 8)
Sheets("main").Cells(v, 2) = Sheets("work").Cells(6, 9)
'Sheets("main").Cells(v, 12) = Sheets("work4").Cells(5, 3) & "/" & Sheets("work4").Cells(5, 4)
Sheets("main").Cells(v, 12) = Sheets("work").Cells(6, 6)
End If

v = v + 1
If v > 35 Then
Exit Do
End If

Loop

End Sub
変数で連続実行させてますが
↓のマクロでシートのE6から最終行を取得しデータが一致した行を削除したいのですが同時に別シートに削除した内容を転記させたいです。(データが蓄積するように空いてるセルにデータが下に向かって入っていく感じです)
配列で(ARRYとか)連続実行しない変数を使用しない転記のマクロは知ってますが・・。データ一致行削除に転記も組み込みたいのでが教えていただけませんでしょうか??
Sub データ一致行削除・転記()
Dim maxrow As Long
Dim i As Long
maxrow = Cells(Rows.Count, 6).End(xlUp).Row

For i = maxrow To 1 Step -1
If Cells(i, 6) = "aaa" Then
Range(Cells(i, "N"), Cells(i + 4, "R")).Copy
'コピーしたセルの値をシートに転記
Worksheets("転記用シート").Cells(i - 1, "B").PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Worksheets("main").select
Rows(i).Delete
End If
Next i
End Sub
こんな感じですが・・アドバイスお願いします
Posted by takoyakiudon at 2013年11月07日 14:25
お世話になります((。´・ω・)。´_ _))ペコ
転記ですがPCに向かって自分で色々試しながら調べたりして何とかこんな感じで結果を出す事が出来ました。
Sub データ一致行削除転記()
Dim maxrow As Long
Dim i As Long
maxrow = Cells(Rows.Count, 6).End(xlUp).Row
For i = maxrow To 1 Step -1
If Cells(i, 6) = "aaa" Then
'コピーしたセルの値をシートに転記
Range(Cells(i, 2), Cells(i, 16)).Copy
Worksheets("転記用シート").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range(Cells(i, "N"), Cells(i + 4, "R")).Copy
Worksheets("main").Select
Rows(i).Delete
End If
Next i
End Sub
やっぱり動かしながら確認せんとダメダメですね。。しっかり勉強しなければ・・。
Posted by takoyakiudon at 2013年11月10日 00:30
おお。解決できたのですね。素晴らしい!
遅くなりましたが、APIを使った簡単な例をあげておきました。すみません。本当に簡単なものです。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php
まあ、確かにAPIを使うとハンドルを取得して他のアプリケーションに影響を与えたりできてしまうので、慎重に使った方がいいとは思いますが、多少のことではPCが壊れたりしません。いろいろ試してみましょう。

少し前になりますが、伊丹空港出張付きという仕事があったので志願したのですが、若い男性に負けてしまいました。無料で吹田キャンパスが見学できるかと期待したのですが甘かった……。先日「スマホ変えていい?」とかメールしてきたので、息子も多分梅田あたりで買い物をしているのではないかと思います。
Posted by ちょびちょび at 2013年11月10日 22:23
お世話になります((。´・ω・)。´_ _))ペコ
おお、ありがとうございます。ツール拝見致しました。
中身を見てみるとVBAのコードとは違って見慣れないコードですねぇ・・。VBのような(?)雰囲気ですね。Constってほぼ使っているもの市販の教則本などで見ないですがどういう意味の宣言ですか?
パブリックConstとか。
ちなみにVBってVBAと全く別物ですよね?VBのコードをVBAで使えたり・・なんて事あるのでしょうか??
出張ですかー私は出張なんてほぼ無いですがたまに社外研修など出掛けると他業種の方とお話する機会があるので参考になります。また違った刺激を受ける事もありますがあんましそういう機会は与えてもらえませんね(;^ω^)アハハ
息子さんは関西で学生さんなんですか?
Posted by at 2013年11月12日 03:00
改めて見返すと余分なコードが残ってますねー。最初おみくじには背景色がついていました。あまりにセンスが悪かったので削除したつもりでしたが、中途半端でしたね。
Const は定数の宣言です。Public は「Excel VBA スコープ」とかで検索すると詳しい説明が出てくると思います。Sub や Functionの中で宣言されている変数や定数はSub や Functionの中でしか参照できなくて、Sub や Functionの外にあるDim とか Private は同じモジュール(Module1とかSheet1とか)内で参照できます。Publicを付けると別のモジュールからも参照できます。KERNEL32.dll というdllのSleepという命令はModule1にありますが、Publicで宣言してあるのでSheet1のCommandButton1_Clickからでも使えるんです。Module1のコードは1行で書くか複数行に折り返して書くかぐらいの選択しかなく、決まり文句です。
VBとVBAは似てますが、そのまま移植するのは無理ですね。しかし、少しの修正で使えないことはないです。
「国立ならどこでもいいぞ」と言ったら大阪に行ってしまいました。寝る前に読み聞かせる絵本は、日本昔話ではなく、日本笑い話。英会話ではなく落語のテープを聞かせて育てたから大阪に行ってしまったんでしょうかねー。少し暗い義務教育期間を過ごした子どもでしたが、とても楽しい大学生活を送っているようです。
Posted by ちょびちょび at 2013年11月12日 22:27
お世話になります((。´・ω・)。´_ _))ペコ
お子さんも学生生活を楽しんでおられるのですね〜。ウチの子もそういう時が来るんでしょうね・・。

またまた質問で恐縮ですが
B5からJ5までデータが入ってるエクセルシートがありそれが下に向かって続いてます。
そのシートは他部門に応援生産してもらってるリストのようなものなのですが依頼出来る場所と品名、個数が1日に決まってまして(ここでは仮に5品種としておきます。ちなみにB5にロットNO、C5に品名、D5に日時、・・J5に依頼先が入ってます)
セルのD1からH1に依頼先もしくは品名を入れて実行したらBOOKの別シートに依頼状況を転記するものを作りたいのですがどのような案がありますか?
当初ADOで転記しようとしましたが上手く出来ませんでした。ボタン押してUserForm出現させて品名と依頼先入力したら別シートに転記とかがカッコイイかなーとも考えてます・・(´・ω・`)ショボーン・・・
Posted by takoyakiudon at 2013年11月20日 04:28
では、ユーザーフォーム使ってみましょうか。

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

あ。Win7になったのでしたっけ? 古いバージョンで保存してしまいました。コードを一度チェックして.xlsのところを.xlsxに書き換えないと古いバージョンで保存してもいいですか? と余分なメッセージが出ます。気にしないでOKしても大丈夫です。
また、Dドライブ直下にBook1+時刻という名称でBookができてしまうので、都合が悪かったら変更してから実行して下さい。
依頼先をテキストボックスにしても品名をコンボボックスにしてもよいのですが、見本なので両方のコントロール使っています。最初は両方テキストボックスだったのですが、テストしたとき依頼先がセレクトされなかったので、何故? と思ったらAを全角で入力していました。まあ、お客様によってはそんなところも自動で判定せよ! というご要望があったりしますが、社内ツールでしたらそれほど厳しくなくてもいいかな……と。それより、依頼先、品名は固定ならコンボボックスの方が面倒が少ないかと思います。一覧から重複した依頼先、品名を省いてコンボボックスを編集することもできます。しかし、品名はともかく依頼先が頻繁に変更されることはないような気がしますしー。テキスト入力可のコンボボックスが一番汎用的かと思います。
Posted by ちょびちょび at 2013年11月20日 11:01
お世話になります。まだ仕事忙しくパソコン設置してないので古いバージョンでOKです(^_^)v
おぉ!素晴らしい出来です。依頼先に複数の品名を送り出すのでユーザーフォームの品名を10個くらいにして依頼先選択して入力してある品名のみ(入力されてないフォーム欄は無視し)転記するにはどうしたらよいですか?
Posted by takoyakiudon at 2013年11月20日 20:49
ちょっと変更して入れ替えました。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php

追伸:すみません。Operator:=xlFilterValues は2003以前は使用できないそうです。製品のところのFilterを別の方法で抽出しないといけないかもしれません。試してみて結果をお知らせください。
Posted by ちょびちょび at 2013年11月20日 22:56
お世話になります((。´・ω・)。´_ _))ペコ
確認しました。
コンパイルエラー、変数が定義されていません
と出ます。。

一応DドライブにBOOKが蓄積されてしまうのは都合が悪いので同じBOOKのシートにデータ転記にしました。

フォームのチェックにレ点を複数入れれてチェックある品名を各シートごとに転記しデータの依頼日ごとに何ロット出したか解かるように見える化したいのですがそんな事出来ますかねぇ?(・ω・ )?
Posted by takoyakiudon at 2013年11月22日 13:57
Filterは諦めてSQLで抽出するようにしました。
http://www.bec-co.sakura.ne.jp/dataland/Repository.php

Posted by ちょびちょび at 2013年11月23日 00:32
お世話になります((。´・ω・)。´_ _))ペコ
おお、素晴らしいツールです。使ってみましたがちょびさんの作られたものそのまま使用すると問題なく使用出来ます。んで、使いたいデータに改変して使用してみると[Microsoft][ODBC ExcelDriver]
パラメータが少なすぎます。3を指定してくださいとエラー(Set rs = cn.Execute(vSQL))になってしまいます。もともとのデータがxlsm形式だったのでマクロ実行後ADOのせいなのか以前質問させて頂いたトラブルのマクロとシートが増殖していった為元データをxlsに変更しました。そうしたら増殖はなくなりました。パラメータが・・って事だったので[]で囲んでみたりもしましたがん〜・・。どうでしょう。改変箇所ですがaryHeader = Array("ロットNO", "品名", "能力枠", "依頼日", "依頼シフト", "完了日", "完了シフト", "回収シフト", "依頼内容", "依頼先")と一項目追加したのでFor j = 1 To 9→10にしました。
Posted by takoyakiudon at 2013年11月24日 16:07
そのエラーはSQL文のカラム名が違ったりすると出ます。列が増えたのでB2:JではなくB2:K。order byの日時は削除して、修正後の正しい見出し名にして下さい。

vSQL = "select * from [Sheet1$B2:K" & maxRow & "] where 依頼先='" & Me.cmb依頼先 & "'"
vSQL = vSQL & " and 品名='" & cond(i) & "' order by 依頼先,依頼日
Posted by ちょびちょび at 2013年11月24日 20:08
お世話になります((。´・ω・)。´_ _))ペコ
回答ありがとうございます。
書き忘れておりました。。品名で・・と言ってたんですけど"能力枠"という品名を纏めたカテゴリー?みたいなものに改変しております。品名の次のセルです。並びはaryHeader = Array("ロットNO", "品名", "能力枠", "依頼日", "依頼シフト", "完了日", "完了シフト", "回収シフト", "依頼内容", "依頼先")この並びなんですが
vSQL = "select * from [経歴表$B2:K" & maxRow & "] where 依頼先='" & Me.cmb依頼先 & "'"
vSQL = vSQL & " and 能力枠='" & cond(i) & "' order by 依頼先,依頼日"と改変してました。アドバイスいただいたSQLがおかしい・・との事で再度文字が間違ってないかと確認してみたんですが・・あれれ、上手くいきません。。
こちらのカラムの場所も変えてみましたが・・こちらも変更必要ですかねぇ?

Columns("B:E").EntireColumn.AutoFit '
Columns("E:E").NumberFormatLocal = "yyyy/m/d"とかに変えてみたんですけど。。
Posted by takoyakiudon at 2013年11月25日 10:51
もう一つ言い忘れておりました。。無関係かと思われますが作って頂いたマクロとフォームをもともと使っているVBAが組んであるBOOKに移植しております。(ユーザーフォームを出現させてロットNOを入力すると品名を取得し(品名はクエリで隣にDBシートがありWorksheetFunction.VLookupでユーザーフォームのテキストboxに表示)依頼日とシフトが入る。開始チェックボックスをチェックすると開始。完了チェックを押すとその入力されてあるロットNOを探して完了日とシフトが入る)

ちなみに作って頂いたやつそのままデータを改変して実行しましたら[Microsoft][ODBC ExcelDriver]
こちらは抽出条件でデータ型が一致しませんと出ます。改変せずに使用は問題なく動きます。説明不足で申し訳ありません。
Posted by takoyakiudon at 2013年11月25日 11:40
参照設定が不足していると思われます。下記を参照して設定してください。
http://www.happy2-island.com/access/gogo03/capter00307.shtml

依頼先と能力枠は現在文字列扱いですが、新しいBOOKでセルの表示形式は何を設定していますか? 標準のままではないかと思います。標準でも数字以外の文字が入っていれば問題ないのですが、数字のみですとExcelが「数値のカラムだな!」と余計な気を遣って数字扱いになります。その場合は抽出する値を囲んでいる'を削除するかセルを文字列にしてあげないとエラーが出ます。
Posted by ちょびちょび at 2013年11月25日 12:47
お世話になります((。´・ω・)。´_ _))ペコ
参照設定ですが予め新しいBOOKでのADOの設定はオブジェクト2.8で実行しておりました。依頼先と能力枠ですがご指摘の通り標準になっておりましたので文字列に変更しましたが特にかわらず・・抽出する値を囲んでいる'を削除しましたがパラメータが少なすぎます5を指定して下さい、とエラーに・・と悩んでおりましたがおそらく [経歴表$B2:K" ではなく [経歴表$B4:K" がエラーの原因だったかと思います。変更しましたところ無事新しいBOOKで動かす事が出来ました。ありがとうございますヽ(´□`。)ノ・゚

あと一日に何度も使うので能力枠ごとに作成したワークシートにデータを上書きしていきたいのですがWorksheets.Addではなく予め能力枠別のシートが複数仮に作って置いてそこにデータが割り振られるってのは可能でしょうか??(・ω・ )?
そろそろ12月でかなり冷え込んで来ましたがお布団から出にくい感じになっております。。
Posted by takoyakiudon at 2013年11月26日 05:33
Worksheets.Add
ActiveSheet.Name = cond(i)
この2行を削除して下の4行に変更すると同じシートに上書きできます。
Worksheets(cond(i)).Select
Range("A1").Select
Cells.Select
Selection.Clear
Posted by ちょびちょび at 2013年11月26日 07:07
お世話になります((。´・ω・)。´_ _))ペコ
無事理想の形になりました!ありがとうございます!
ちなみにxlsm形式読む場合ってやはりシートやマクロ増殖などバグ発生しますかねぇ・・?
Posted by takoyakiudon at 2013年11月26日 11:51
ブック1つで処理が完結していれば増殖はないような気がします。2007以降はそのような不具合はなくなってきてますし。また何か不思議な現象が発生したら教えて下さい。勉強になります。
Posted by ちょびちょび at 2013年11月26日 20:05
Xlsm形式だと拡張子変更とExcel12.0に変更すれば良いですか?
Posted by takoyakiudon at 2013年11月27日 05:56
拡張子を変更するのではなくExcel2007以上のバージョンで開いてExcel マクロ有効ブックで保存して下さい。12.0というのはObject Library のことでしょうか。VBAを実行してみて正常に動くようなら特に変更は必要ないかと思います。
Posted by ちょびちょび at 2013年11月27日 07:36
お世話になります((。´・ω・)。´_ _))ペコ
会社で実行したところ動作は別に問題なくマクロ有効ブックでも特にマクロ・シート増殖など問題ありませんでした。ですがマクロ有効ブックと変更前両方ですがBOOKの保存の有無に関わらず閉じた際にVBAプロジェクトに一応ロック掛けてますがパスワード入力する画面?(ロック掛かったVBAを開く際出現するやつ)が勝手に出る事が数回ありました。(・ω・ )ハテ?キャンセルボタン数回押せば消えるんですが気持ち悪いなぁ〜と思ってましたが時間が経ってもう一度BOOK開いて閉じた時には出ませんでした。何でしょうね?PC環境のせいでしょうか??自宅PCではその現象は起きませんでした。ちなみにですがシートに転記させた際に同じ日付(依頼日)のデータを色で自動で視覚的に解かりやすくする為に纏めたいのですが(依頼日が別のデータと分けて見やすくする感じ)同じ日付データ数は決まって無いので5件だったり20件だったりします。違う日付になったデータの集まりになったら色が変わる・何だか説明がおかしいですが単純に黄色と白(色付けない)の繰り返しでも良いのですが出来ますか?色を付けるマクロで検索したのですがちょっとイメージの違うものしか見付かりませんでした。それかピボットテーブルで依頼先にその日何ロット応援出したか自動で作成するマクロとかでも良いかなぁって考えてます。・・ちなみにピボットテーブルはこれから勉強しようと思っております。恥ずかしながらまだ使用経験がありません・・。
Posted by takoyakiudon at 2013年11月28日 00:35
変数の定義を増やしてください。
Dim aryColor As Variant
Dim iColor As Integer
Dim iRow As Integer
Dim iCount As Integer
Dim pvt As PivotTable
Dim k As Integer

aryHeader = Array()の次行に下記1行追加。好きな色、好きな個数指定して下さい。
aryColor = Array(16764159, 10079487, 10092543, 10092441, 16777164, 16772300, 16764108)

品名ごとにシート作成のFor文をこのように変更するとセルに色がつきます。罫線も追加しました。
For i = LBound(cond) To UBound(cond)
vSQL = "select * from [Sheet1$B4:K" & maxRow & "] where 依頼先='" & Me.cmb依頼先 & "'"
vSQL = vSQL & " and 品名='" & cond(i) & "' order by 依頼先,依頼日,ロットNO"
Set rs = cn.Execute(vSQL)
Worksheets(cond(i)).Select
Range("A1").Select
Cells.Select
Selection.Clear
For j = 1 To 10
Cells(1, j) = aryHeader(j - 1)
Next
Range("A2").CopyFromRecordset rs
Set rs = Nothing
Set rCell = ActiveSheet.UsedRange
iRow = rCell.Rows.Count
'指定条件に該当するデータが存在する場合のみ処理を行う
If iRow > 1 Then
'L1を先頭にピボット作成。別の場所につくってもいいですし、処理が終わったらクリアしてもいいかと思います。
Set pvt = _
ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rCell). _
CreatePivotTable(TableDestination:=Range("L1"))
With pvt.PivotFields("依頼日")
.Orientation = xlRowField
End With
With pvt.PivotFields("依頼日")
.Orientation = xlDataField
.Function = xlCount
End With
j = 2
iCount = 2
'ピボットの依頼日列が日付でなくなったら処理終了
Do
If Not IsDate(Cells(iCount, 12)) Then
Exit Do
End If
k = j + Cells(iCount, 13) - 1
Range("A" & j & ":J" & k).Select
Selection.Interior.Color = aryColor((iCount - 2) Mod UBound(aryColor))
j = k + 1
iCount = iCount + 1
Loop
Columns("A:J").EntireColumn.AutoFit
Columns("D:D").NumberFormatLocal = "yyyy/m/d"
'見出しの前景色、背景色変更
Range("A1:J1").Select
Selection.Font.ThemeColor = xlThemeColorDark1
Selection.Interior.Color = 6299648
Selection.Font.Bold = True
'罫線
Range(Cells(1, 1).Address, Cells(iRow, 10).Address).Borders.LineStyle = xlContinuous
End If
Next

パスワードを聞かれる件については今のところ不明なので、また後ほど。
Posted by ちょびちょび at 2013年11月28日 12:24
パスワード入力画面は7回も出るのですか? 
Microsoft Office Live Add-in x.x をアンインストールすると出なくなるそうです。
Posted by ちょびちょび at 2013年11月28日 17:12
お世話になります。
((。´・ω・)。´_ _))ペコ
まさに理想の形に完成する事が出来ました。
ありがとうございました!
パスワード入力画面ですが7回も出なかったと思いますが数回出る事があります。また出ないときもあります。アンインストールすると出なくなるんですね。ちょっと検討してみます
Posted by takoyakiudon at 2013年11月30日 18:41
お世話になります((。´・ω・)。´_ _))ペコ
難しいリクエストかと思われますが周囲の同僚から一日に何ロット出しているか解かる様になったのは凄い助かるが大人の事情で一日に応援依頼するロット数が決まってしまいまして一日にここの依頼先にこの品名はあと何ロット応援依頼が出せてそして別のあの品名はあと何ロット出せるか見える化して欲しいと要望があり正直困ってしまいました。一ヶ月に応援依頼する計画が立てられるのですがこの依頼先に一日あたりこの品名何ロット、あの品名何ロットとお上から命令が来るのでシートに依頼先、「品名1」○ロット
「品名2」○ロット「品名3」・・と予め入力して置き(一ヶ月固定なので入力した値は保持されるのが望ましいです)ユーザーフォーム実行して一覧表示された時ににピボットテーブルの下辺りに
あと○ロット応援出せますみたいに表示させる事可能でしょうか?説明がヘタクソな上にお忙しい中大変恐縮ですがよろしくお願いしますm( __ )m
Posted by takoyakiudon at 2013年12月02日 03:33
入力と出力が決まれば、それほど難しい処理ではないと思います。とは言ってもそれほどすぐにはできませんが、取りあえず、入出力は以下のようなイメージでよろしいでしょうか? また、あと○○ロットというのは依頼先別に1日単位(応援依頼シートに記載されている数 マイナス ピボットで集計した数)で大丈夫ですか? これを1カ月の累計とか言われますと難しいですが、1日単位でしたらなんとかなるでしょう。今月から違うプロジェクトに参加しますので、今日顔を出してみないと様子が分からないのですが、最初からハードな勤務時間を強いられることはないと思いますので、今晩でもサンプル作ってみますね。

■参照元
シート名:応援依頼
見出し:依頼先、品名、ロット数

■出力先
場所:ピボットテーブル下
見出し:品名、ロット数
Posted by ちょびちょび at 2013年12月02日 07:12
おぉ・・お忙しいとこすいません…(((( ;゜Д゜)))
よろしくお願いします
Posted by takoyakiudon at 2013年12月02日 14:07
応援依頼シートを追加(依頼先,品名,ロット数)

================================================================
変数追加
Dim intIrai As Integer

================================================================
For i = LBound(cond) To UBound(cond) の次行に下記を追加

'応援依頼シートより依頼先、品名で1日に依頼できるロット数を取得する
Worksheets("応援依頼").Select
maxRow = ActiveSheet.Range("A1").End(xlDown).Row
intIrai = 0
For j = 2 To maxRow
If Cells(j, 1) = Me.cmb依頼先 And Cells(j, 2) = cond(i) Then
intIrai = Cells(j, 3)
Exit For
End If
Next

================================================================
Do
If Not IsDate(Cells(iCount, 12)) Then
Exit Do
End If
の次に下記を追加

'N列に依頼できる残数を表示
Cells(iCount, 14) = intIrai - Cells(iCount, 13)

================================================================
すみません。作ってみようとしたら、
>ピボットテーブルの下辺りにあと○ロット応援出せます
のところをよく理解していませんでした。これは日付別に依頼残数を表示する感じですか? 取りあえずN列に残数を表示してみました。 
Posted by ちょびちょび at 2013年12月02日 22:55
お世話になります((。´・ω・)。´_ _))ペコ
早速試してみましたが
Set rs = cn.Execute(vSQL)
のところでエラーになってしまいます。
([Microsoft][ODBC ExcelDriver]
パラメータが少なすぎます3を指定して下さい。)
確認ですが"応援依頼"シートを追加作成しA1から見出しで依頼先、能力枠(品名から変更してます)ロット数。A2から実際のデータを入力してます。intIrai 変数追加。前回教えて頂いた箇所にコードを挿入しました。


vSQL = vSQL & " and 能力枠='" & cond(i) & "' order by 依頼先,依頼日"品名から能力枠に替えてますのでこの様になってます。
ちなみに一覧のデータの並びですがaryHeader = Array("ロットNO", "品名", "能力枠", "依頼日", "依頼シフト", "完了日", "完了シフト", "回収シフト", "依頼内容", "依頼先")でSQLは品名の隣の能力枠に変更してます。これから出社なので会社でも試してみます。
Posted by takoyakiudon at 2013年12月03日 14:40
お世話になります。会社で試したところsqlの箇所でB4Kの所をB4K4に変更したら無事動きました。ありがとうございました!
Posted by takoyakiudon at 2013年12月03日 16:54
お世話になります((。´・ω・)。´_ _))ペコ
今までの機能は保持し一覧が表示・入力されているシート(SQLを発行するデータがある元のシート)にもあと応援依頼可能なロット数の一覧を表示される事って可能でしょうか?SQL発行後の応援依頼かけている一覧の累計も大事ですがメインの一覧にもあと何ロット応援依頼出切るか把握して無駄なデータの入力を避けたい、と意見がありまして大変難しいと思いますがお知恵をお貸し下さい・・。
Posted by takoyakiudon at 2013年12月04日 05:42
またスクロールが面倒になってきましたので、場所を変えましょう。
http://chobi2dataland.sblo.jp/article/42802570.html#comment
Posted by ちょびちょび at 2013年12月04日 21:41
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

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

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