Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

305 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76327】2つのブック　一致したIDを区分毎で日付...

XYZ - 14/10/30(木) 23:31 -


	引用なし

	パスワード

2つのエクセルブックがあります。

1つがIDデータ表になって、IDと払い出し内容と日付の３つがあります。
もう１つがID管理票で、IDを担当ごとに管理している票です。

IDデータ表のIDとID管理票のIDを一致したら
IDデータ表の払い出し区分の単語を基準に（新規・変更・廃止）

ID管理票.xlsに乗っているIDの横に
払い出し区分の単語の条件で

新規の場合,ID右隣に日付を転記
変更の場合,IDの２つ右隣に日付を転記
廃止の場合,IDの３つ右隣に日付を転記を行いたいのですが

マクロで可能でしょうか？

関数で処理をしようと思いましたが
すでに、転記する側のID管理票に関数がかなり使われて
ファイルが重い状態ですのでマクロで処理をしたいと思っております
　　　　　　　　　　　　
お手数ですがお力添えをお願いします。
下記に簡素でありますが構成状態と
処理の概要を書かせて頂きます。

IDデータ表.xls

　　 A列　　　　　　　 B列　　　　　　　C列
1　　ID番号　　　　払い出し区分　　　　日付
2　 110001241　　　　　新規　　　　　　10/2
3　 120000065　　　　　変更　　　　　　10/3
4　 190000036　　　　　廃止　　　　　　10/4
　　　 ↓

以下100行くらい続いています

ID管理票.xls

ID番号の場所がバラバラで
AO列にあったりBC列にあったりしています。
また、ID管理票にすでに日付が入っていることもありますが
それはそのまま上書きで問題ありません。

110001241,　10/2　　　　　　　（新規区分なのでIDの右隣に日付を転記）
120000065,　空白 10/3　　　　（変更区分なのでIDの右２つ目に日付を転記）
190000036,　空白,空白,10/4　　 (廃止区分なのでIDの右３つ目に日付を転記）

・ツリー全体表示


	【76325】これ以上詳しくできません

γ - 14/10/30(木) 21:42 -


	引用なし

	パスワード

▼hamako さん：
>遅くなりましてすみません。
>
>頂いたコードをどのように組み入れれば
>よいでしょうか・・・m(__)m
>
>色々試してみたのですが、よくわからなくて
>
>今標準モジュールのモジュール1に
>
>Sub test()
>　　Application.OnTime Now, "my_Procedure"
>　　ThisWorkbook.Close False
> End Sub
>
> Sub my_Procedure()
>　　Workbooks.Open ThisWorkbook.FullName
> End Sub
>
>
>が入ってます。
>これを変更しますか？m(__)m

そうです、変更するのです。
Workbooks.Open ThisWorkbook.FullName
の代わりに、示した3行で置き換えて下さい。

要は、
・警告を発するオプションを外して（黙らせて）
・開いて、
・警告を発するオプションを、元に戻す
ということをしているのです。

・ツリー全体表示


	【76324】すみません。もう少し詳しく教えてくださ...

hamako - 14/10/30(木) 14:14 -


	引用なし

	パスワード

遅くなりましてすみません。

頂いたコードをどのように組み入れれば
よいでしょうか・・・m(__)m

色々試してみたのですが、よくわからなくて

今標準モジュールのモジュール1に

Sub test()
　　Application.OnTime Now, "my_Procedure"
　　ThisWorkbook.Close False
End Sub

Sub my_Procedure()
　　Workbooks.Open ThisWorkbook.FullName
End Sub

が入ってます。
これを変更しますか？m(__)m

遅くなり、かつ、お手数おかけしますが、
よろしくお願いいたします。

・ツリー全体表示


	【76323】Re:シフトアップ

独覚 - 14/10/30(木) 13:54 -


	引用なし

	パスワード

▼ななこさん：
特に不愉快に思っているわけでは無いのでご安心を。

ただ、マクロの記録を行っていて気づいたんですが「値の貼り付け」のマクロ記録、
ちょっとおかしな記録の仕方をしているように思えます。

貼り付け位置のセルを選択してから
ActiveSheet.PasteSpecial
という流れは本来、他のアプリケーションなどでコピーしたものをExcelに張り付ける場合のもので
同じExcel内であれば
Range(C6).PasteSpecial
となるのではないかなと。

基本はSelectとSelectionをまとめることなので

>　　Range("C7:F13").Select
>　　Selection.Copy
>　　Range("C6").Select
>　　ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
>　　　　IconFileName:=False
>　　Range("A1").Select
は
　　Range("C7:F13").Copy
　　Range("C6").Select
　　ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
　　　　IconFileName:=False
になりますが最初に書いた点を反映させると
　　Range("C7:F13").Copy
　　Range("C6").PasteSpecial Paste:=xlPasteValues
で、どうでしょうか？

・ツリー全体表示


	【76322】できません。

追加 - 14/10/30(木) 13:52 -


	引用なし

	パスワード

　　　　　Dim ccc As Control, jjj As Control

　　　　　　 For Each ccc In Controls
　　　　　　　　If ccc.name = "Frame_tmp" Then
　　　　　　　　
　　　　　　　　　　For Each jjj In ccc.Controls
　　　　　　　　　　　 Debug.Print jjj.name
　　　　　　　　　　　　

　　　　　　　　　　　　'Controls.Remove (jjj.name)
　　　　　　　　　　Next jjj
　　　　　　　　　　
　　　　　　　　　Exit For '見つかったのでout
　　　　　　　　End If
　　　　　　 Next ccc

デバッグしたら以下のように出てきます。

CheckBox0
CheckBox1
CheckBox2
CheckBox3
TextBox3
SpinButton3
Label3
CheckBox16

'コメントをのけて走らせるとエラーになります。
なぜ？

・ツリー全体表示


	【76321】Re:シフトアップ

ななこ - 14/10/30(木) 12:42 -


	引用なし

	パスワード

▼独覚さん
不愉快な思いをさせてしまったようですみません。

　　Range("C7:F13").Select
　　Selection.Copy
　　Range("C6").Select
　　ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
　　　　IconFileName:=False
　　Range("A1").Select
End Sub
です。
これをコンパクトにしたいのですが、教えてください。

・ツリー全体表示


	【76320】Re:frameの上のボタン

ふめい - 14/10/30(木) 12:21 -


	引用なし

	パスワード

▼ichinose さん：
　ありがとうございます。

helpを調べてみます。

>▼ふめいさん：
>>▼ichinose さん：
>>
>>感謝です。
>>fm.controlsはまったく思いつかなかったです。
>>
>>Private Sub OptionButton10_Change()
>>
>>　　　　If OptionButton10.Value = True Then
>>　　　　　　'動的にcheckboxを生成
>>　　　　Else
>>　　　　　　'作ったcheckboxを消す。(隠すではなく消したい)
>　　　　　　 controls.remove "Checkbox1" '←消したいコントロール名
>>　　　　End If
>>
>>End Sub
>>
>
>これらは、Helpに出ていますよ

・ツリー全体表示


	【76319】Re:写真　縦横比

KIEV - 14/10/30(木) 11:12 -


	引用なし

	パスワード

いろいろと触っているうちに　目的の動作ができるようになりました。
内容についてはぼんやりとしか理解していません。
修正箇所等ありましたら教えてください。

Sub 写真貼付()
Dim PIC
Application.ScreenUpdating = False '描画OFF
ChDir "D:\ピクチャ" ' パス

PIC = Application.GetOpenFilename("画像ファイル " & _
"(*.emf;*.wmf;*.jpg;*.jpeg;*.jpe;*.png;*.bmp), " & _
"*.emf;*.wmf;*.jpg;*.jpeg;*.jpe;*.png;*.bmp", _
Title:="ファイル選択")
If PIC = False Then Exit Sub
Set PIC = ActiveSheet.Pictures.Insert(PIC)

With PIC
.Top = ActiveCell.Top　'基準位置　上
.Left = ActiveCell.Left '基準位置　左
.Placement = xlMove 'セルに合わせて移動する。
.PrintObject = True 'オブジェクトを印刷
End With

With PIC.ShapeRange
.LockAspectRatio = msoTrue '縦横比を維持する
.Width = ActiveCell.MergeArea.Width ' 画像の幅をアクティブセルにあわせる
End With

Application.ScreenUpdating = True '描画ON
End Sub

・ツリー全体表示


	【76318】Re:シフトアップ

独覚 - 14/10/30(木) 11:03 -


	引用なし

	パスワード

▼ななこさん：
>独覚さん
>すみません、わたしの説明不足でした。
>
>Sheet1[C6：F10]にデータが入っています。[罫線（格子）で囲っています。]
>図形ボタンを設置しています。
>ボタン押した時に[C6：F6]データを消して[C7：F10]のデータをシートアップさせたいのです。
>＊罫線（格子）は[C6：F10]のままで。

だからその手順を書いていますがどこが問題になっているのかを書いてくれませんか？

・ツリー全体表示


	【76317】Re:シフトアップ

ななこ - 14/10/30(木) 10:53 -


	引用なし

	パスワード

独覚さん
すみません、わたしの説明不足でした。

Sheet1[C6：F10]にデータが入っています。[罫線（格子）で囲っています。]
図形ボタンを設置しています。
ボタン押した時に[C6：F6]データを消して[C7：F10]のデータをシートアップさせたいのです。
＊罫線（格子）は[C6：F10]のままで。

・ツリー全体表示


	【76316】写真　縦横比

KIEV - 14/10/30(木) 10:35 -


	引用なし

	パスワード

結合セルの横幅に合わせて　写真を貼り付けようとしています
縦横比を維持して貼り付けるにはどのようにすればよいでしょうか？
現在以下の状態です。

Sub 写真を1枚貼付ける()

Dim PIC
ChDir "D:\ピクチャ" ' パス

PIC = Application.GetOpenFilename("画像ファイル " & _
"(*.emf;*.wmf;*.jpg;*.jpeg;*.jpe;*.png;*.bmp), " & _
"*.emf;*.wmf;*.jpg;*.jpeg;*.jpe;*.png;*.bmp", _
Title:="ファイル選択")
If PIC = False Then Exit Sub

With ActiveSheet.Pictures.Insert(PIC)
.Width = Selection.Width ' 画像の幅をアクティブセルにあわせる
'縦横比を維持する。
End With
End Sub

・ツリー全体表示


	【76315】Re:シフトアップ

独覚 - 14/10/30(木) 10:02 -


	引用なし

	パスワード

▼ななこさん：
ごめんなさい。
書き込みをよく読んでいなかった。
前回

>J1からJ1以降でデータの入力されている最後から下へ三つ行ったセルまで選択、そのセル範囲をコピーして
>G1セルに張り付け(値の貼り付け？)
>ではないのかな？
と書いたようにデータの最終行より下の部分までコピーしておいてそれを「値の貼り付け」
でどうでしょう？

今回の説明であればＣ5：Ｄ5は上書きされるので最初に削除しとく必要は無し。
コピー範囲をＣ6：Ｆ10としておけば9行目もデータなしの10行目のデータで上書きされるので
結果的にクリアされると思うけども。

・ツリー全体表示


	【76314】Re:印刷品質を300dpiにする

KIEV - 14/10/30(木) 9:10 -


	引用なし

	パスワード

γ さん
質問分かりにくくてすみません。

記載して頂いた内容で完璧です。
これで作業がかなり楽になります

ありがとうございました。

・ツリー全体表示


	【76313】Re:文字をブリンク（数回点滅）させる方法

T.Namba - 14/10/30(木) 8:48 -


	引用なし

	パスワード

▼カリーニンさん：
>APIのSleep関数を使います。
>また、色を変えたら
>DoEvents
>を入れて画面の再描画を反映させます。
>
>
>Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
>
>Sub test()
> Dim i As Integer
> Dim iro As Integer
> Dim c As Range
>　Set c = ActiveCell
>　iro = 3
>　For i = 0 To 5
>　 '文字の色を変える
>　 c.Font.ColorIndex = iro
>　 DoEvents
>　 Sleep 500
>　 '文字の色を戻す
>　 c.Font.ColorIndex = xlAutomatic
>　 DoEvents
>　 Sleep 500
>　Next i
>　Set c = Nothing
>End Sub

カリーニン様
ありがとうございました。
Sleepというのは初めて知りました。
大変勉強になりました。

・ツリー全体表示


	【76312】Re:行列を返す関数

ichinose - 14/10/30(木) 8:29 -


	引用なし

	パスワード

▼しゅくまるさん：
>ワークシート関数のMMULTのように、行列を返す関数を作りたいです。
>戻り値の扱いが分からないので教えてほしいです。
>たとえば、
>関数 test(A as Range, B as Range) as variant を定義して、
>戻り値として、行列の掛け算A*Bの結果として a(i,j)が計算され、
>セルCiからにEjに={test(Ai:Cj,Dj:Dj)}と入力した場合に
>セルCiからにEjにa(i,j)を代入するという
>つまり、例としてMMULT関数と同じことをさせたいです。
>戻り値の代入test=a()で#VALUE!エラーになって対処がわからずです。

呼び出しもコードからしてみては？

sub　main()
　 dim ans as variant
　 ans=test(range("a1:c3"),range("d1:d3"))
end sub

これで何かしらのエラーが発生しませんか？

・ツリー全体表示


	【76311】Re:シフトアップ

ななこ - 14/10/30(木) 8:00 -


	引用なし

	パスワード

独覚さん：
>C5:F9にデータが入っています。
>C5:F5を削除で、C6:F9[罫線入り]を≪値のみシフトアップ≫させたいのです。
>>もし、罫線はそのままにしておきたいということであれば「貼り付け」を「値の貼り付け」
C6:F9を【切り取り】をしC5に【値の貼り付け】ができません。
【ただの貼り付け】ならできます。

・ツリー全体表示


	【76310】Re:行列を返す関数

γ - 14/10/30(木) 7:38 -


	引用なし

	パスワード

▼しゅくまるさん：
>戻り値の代入test=a()で#VALUE!エラーになって対処がわからずです。
test = a
なのかな。
コードの全体を見せた方が回答は集まりやすいでしょう。

・ツリー全体表示


	【76309】Re:複数回連続して検索したいが上手くゆ...

γ - 14/10/30(木) 7:33 -


	引用なし

	パスワード

> 次に商品2があるかどうか始めのシートから調査したい
ということなら、「始めから」ということにはなっていませんね。

今のコードに手を入れるなら、
商品1が見つかったとき、新たに、For Nextループで各シートを
検索することになりますね。

ただし、商品1や商品2は複数あるのかどうかにもよって
処理が変わってくるかも、知れません。
複数ある場合、いわば掛け算で何度も検索する必要があるのか、
単に、商品1,商品2をそれぞれ単独で検索してよいのではないですか？

そうした条件をもう少し検討されたほうがよいでしょう。

・ツリー全体表示


	【76308】Re:frameの上のボタン

ichinose - 14/10/30(木) 6:25 -


	引用なし

	パスワード

▼ふめいさん：
>▼ichinose さん：
>
>感謝です。
>fm.controlsはまったく思いつかなかったです。
>
>Private Sub OptionButton10_Change()
>
>　　　　If OptionButton10.Value = True Then
>　　　　　　'動的にcheckboxを生成
>　　　　Else
>　　　　　　'作ったcheckboxを消す。(隠すではなく消したい)
　　　　　　 controls.remove "Checkbox1" '←消したいコントロール名
>　　　　End If
>
>End Sub
>

これらは、Helpに出ていますよ

・ツリー全体表示


	【76307】Re:複数回連続して検索したいが上手くゆ...

ペンネーム船長 - 14/10/29(水) 22:38 -


	引用なし

	パスワード

大変失礼しました。
検索する商品はＤ列にあり、Ｋ列に1階にある商品は「1」と入れてあります。
よって
>>　　w = obj.Offset(0, 7).Value 'G列
ではなく
　　　w = obj.Offset(0, 7).Value 'Ｋ列
でした。
申し訳ありません。

「商品1」がＤ列にあり、Ｋ列に「1」があるとき、次に「商品2」を探す。
Ｄ列から数えて7つ目がＫ列になります。

2回目の検索が無視されてしまいます。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

305 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free