Excel VBA質問箱 IV

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

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


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

196 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【78533】Re:インプットボックスを使用した日付入力

β - 16/11/1(火) 14:57 -


	引用なし

	パスワード

▼マクロ初心者さん：

>下記のマクロのどこが間違っているのでしょうか…？

ans = InputBox("いつ時点の情報ですか？", "日付確認", "")

これを　ループの中で実行しているからです。
ループの前に１回だけ実行しましょう。

・ツリー全体表示


	【78532】インプットボックスを使用した日付入力

マクロ初心者 - 16/11/1(火) 14:25 -


	引用なし

	パスワード

初めまして、従業員の名簿の管理をエクセルにてしているのですが
所属ごとのシートがありそれぞれのシートの構成は同じで
A～AEまで情報が入力されています。

ある特定の日時点での年齢、勤続年数を算出するために
AF1のセルに「特定の日」をまとめて入力したいと思い
下記のマクロを色々調べながら作成したのですが
インプットボックスがシートの枚数分出てきてしまいます…。

私がやりたいのはインプットボックスに日付を入力してOKを押したら
すべてのシートのAF1のセルにその日付が入力されるようにしたいのです。

下記のマクロのどこが間違っているのでしょうか…？
よろしければどなたかご教授頂ければと思います。

Sub 日付入力()

　Dim Sht As Worksheet, ans As String
　For Each Sht In Worksheets
　ans = InputBox("いつ時点の情報ですか？", "日付確認", "")
　　If ans <> "" Then
　　　　Sht.Range("AF1").Value = ans
　　End If
　　
　　Next
　　
End Sub

・ツリー全体表示


	【78531】Re:複数の文字列を置換したい

sy - 16/10/30(日) 17:30 -


	引用なし

	パスワード

▼β さん：

セル数で変わりますね。
この数式の元スレでは10万件なので、試してみたら若干早くなりました。
まぁ0.1秒未満の差なので、今回も含めてどっちでも良いって感じですが^^;

・ツリー全体表示


	【78530】Re:複数の文字列を置換したい

β - 16/10/30(日) 12:00 -


	引用なし

	パスワード

▼sy さん：

syさん、ご指摘深謝。
一括転記の場合、通常、βも Application.ScreenUpdating の手当てはしないのですが
今回、一括書きこみが　３回ありますので、もしかしたら、効果あるかなと。

確かに、一括転記で　ScreenUpdating　の手当てを行うと、逆に　わずかながら
処理時間の足を引っ張りますもんね。

・ツリー全体表示


	【78529】Re:複数の文字列を置換したい

sy - 16/10/30(日) 11:26 -


	引用なし

	パスワード

▼β さん：

＞"=IFERROR(IF(INDEX(List!A:A,MATCH(B1,List!A:A))=B1,VLOOKUP(B1,List!A:B,2),B1),B1)"

この数式で3000件程度にマッチさせるだけなら
Application.ScreenUpdating = False
が無い方が早いと思います。

・ツリー全体表示


	【78528】Re:複数の文字列を置換したい

β - 16/10/29(土) 14:33 -


	引用なし

	パスワード

▼naoko さん：

↑

この方式は別掲示板ですが syさんという方の回答コードを借りました。
ようは、いかに効率的な数式を組み立てることができるかどうかがポイントです。
この方式でも数式がおそまつなら、処理時間の足を引っ張るでしょうね。

数式の優劣にはかかわらず　一定の、まずまずの変換を行う方法としては
変換要素をDictionaryに格納し、変換対象を配列に入れたうえで、
その中を変換して、一括書き戻し。これでも、そこそこの処理効率になりますが。

・ツリー全体表示


	【78527】Re:複数の文字列を置換したい

β - 16/10/29(土) 14:25 -


	引用なし

	パスワード

▼naoko さん：

>また、関数かませるとすっごく重くなるのでダメですね。

いえいえ、提案しているのは、最終的には式は残らず、かつ
【すごく軽い】処理方式です。

ただ、アップされたコード、Ｂ列処理ですけど、コメント内に

>置換されては困る列もあるので、一気には無理だとわかりました。

とあるので、対象列は、複数列なんだと思われます。
まぁ、それならそれで、その列に対してループ処理をかければいいのですが、
以下のコードは　Ｂ列のみ対象。　ためしにデータをマッチするもの中心に
３０００件で動かしますと、私の環境で 0.05秒ぐらいの処理ですね。

条件として List というシートに置き換え表を準備しておきます。
1行目から A列が　

クリニック
ケアミックス病院
回復期病院

等

B列に

8
7
4

等

（A列の値昇順にしてください）

作業列を使っています。コードでは C列にしていますが、どの列でもＯＫです。

Sub Sample()
　　Dim t As Double
　　t = Timer
　　
　　Application.ScreenUpdating = False
　　
　　With Sheets("Sheet1")
　　　　With .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Offset(, 1)
　　　　　　.Formula = "=IFERROR(IF(INDEX(List!A:A,MATCH(B1,List!A:A))=B1,VLOOKUP(B1,List!A:B,2),B1),B1)"
　　　　　　.Offset(, -1).Value = .Value
　　　　　　.ClearContents
　　　　End With
　　End With

　　Application.ScreenUpdating = True
　　
　　MsgBox Timer - t
　　
End Sub

・ツリー全体表示


	【78526】Re:複数の文字列を置換したい

マナ - 16/10/29(土) 12:37 -


	引用なし

	パスワード

▼naoko さん：

>高度すぎてかけないです。。。（爆）

高度というより、どんな操作か理解できていないのでは？

>また、関数かませるとすっごく重くなるのでダメですね。

そんなことない気がします。

>他の会社へ渡すファイルとなるので・・・

最後は、値貼り付けで数式は残りません。

>地道にWith～で列ごとに書いていくことにしました！

マクロ不要で、手作業で十分な作業かもしれません。
少なくとも、コード書いている時間と比較にならないでしょう。

・ツリー全体表示


	【78525】Re:複数の文字列を置換したい

マナ - 16/10/29(土) 11:42 -


	引用なし

	パスワード

▼naoko さん：

こっちのほうが、わかりやすかったかも。

Option Explicit

Sub 連続置換()
　　Dim 検索範囲 As Range
　　Dim 最修行 As Long
　　Dim n As Long

　　Set 検索範囲 = Worksheets("Sheet2").Columns("B")
　　
　　With Worksheets("Sheet1")
　　　　最修行 = .Range("A" & Rows.Count).End(xluo).Row
　　
　　　　For n = 2 To 最修行
　　　　　　検索範囲.Replace _
　　　　　　　　　　What:=.Cells(n, 2).Value, _
　　　　　　　　　　Replacement:=.Cells(n, 1).Value, _
　　　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　　　MatchByte:=False
　　　　Next
　　　　
　　End With

End Sub

・ツリー全体表示


	【78524】Re:複数の文字列を置換したい

マナ - 16/10/29(土) 10:44 -


	引用なし

	パスワード

▼naoko さん：

170行はさすがに大変でしょう
例えば、こんな感じでできるはずです。

Option Explicit

Sub 連続置換()
　　Dim 対照表
　　Dim 検索範囲 As Range
　　Dim n As Long

　　対照表 = Worksheets("Sheet1").Range("A!").CurrentRegion.Value
　　
　　Set 検索範囲 = Worksheets("Sheet2").Columns("B")

　　For n = 2 To UBound(対照表)
　　　　検索範囲.Replace What:=対照表(n, 2), Replacement:=対照表(n, 1), _
　　　　　　LookAt:=xlWhole, MatchByte:=False
　　Next

End Sub

・ツリー全体表示


	【78523】Re:複数の文字列を置換したい

naoko - 16/10/28(金) 14:58 -


	引用なし

	パスワード

βさん：

有難うございます。
高度すぎてかけないです。。。（爆）
また、関数かませるとすっごく重くなるのでダメですね。
他の会社へ渡すファイルとなるので・・・

地道にWith～で列ごとに書いていくことにしました！
置換されては困る列もあるので、一気には無理だとわかりました。

ご回答、有難うございました。

・ツリー全体表示


	【78522】Re:複数の文字列を置換したい

β - 16/10/28(金) 11:34 -


	引用なし

	パスワード

▼naoko さん：

↑で

>処理速度の観点からいえば、これが最も秀逸な結果となります。

こう書きましたが Replace にこだわらなければ、

・提案した変換表の文字列と数値をいれかえて　文字列昇順で並び替えをしておき
・それを変換表として、変換対象の列（B列？）とは別の列に、一挙に数式を埋め込み
　埋め込んだ後、それを値変換で、もとの列を書き換える。

この方式が最速だと思います。

コードも３～４行ですね。

・ツリー全体表示


	【78521】Re:複数の文字列を置換したい

β - 16/10/28(金) 11:20 -


	引用なし

	パスワード

▼naoko さん：

>と永遠と書こうかと思ったのですが

処理速度の観点からいえば、これが最も秀逸な結果となります。

ただ、コードが見づらくなりますし、保守性の観点で難ありですかね？

アップされたイメージを変換表として、別シートに作っておく。
通常は、このシートは非表示でいいのですが、この　変換表を参照しながら
Replace をループさせるという記述をすることで、コードはすっきりしますね。

・ツリー全体表示


	【78520】複数の文字列を置換したい

naoko - 16/10/28(金) 11:03 -


	引用なし

	パスワード

お世話になります。

置換後数値・置換したい文字列
1　　　　男性
2　　　　女性
1　　　　看護学生
2　　　　看護師
3　　　　准看護師
1　　　　総合病院
2　　　　急性期病院
3　　　　大学病院
4　　　　回復期病院
5　　　　療養型病院
6　　　　精神科病院
7　　　　ケアミックス病院
8　　　　クリニック
9　　　　有床クリニック

このように、複数の文字列を数値に変換したいのですが
通常だと
Columns("B:B").Replace What:="男性", Replacement:="1"
Columns("B:B").Replace What:="看護学生", Replacement:="1"
・
・
と永遠と書こうかと思ったのですが、170の文字列（単語）があり
文字列を買いてくのは仕方ないのですが、置換後の文字が数値でだぶることもあるので
これを簡素に書く書き方ってありますでしょうか？

・ツリー全体表示


	【78519】Re:ユーザーフォーム上の画像保存方法

ゆうじん - 16/10/26(水) 11:28 -


	引用なし

	パスワード

▼β さん：
Frameを使用して、目的の画像を保存することができました。
βさん！本当にありがとうございました！！

以下のサイトを参考にしました。
ht tps://support.microsoft.com/ja-jp/kb/161299
キャプチャの対象をFrameのハンドルにすることで解決できました。

Public Function CaptureFrame() As IPictureDisp
　　'　Get a handle to the Frame1.
　　Dim hWndScreen As Long
　　WindowFromAccessibleObject Frame1, hWndScreen
　　
　　Dim cxScreen As Long, cyScreen As Long
　　cxScreen = Frame1.Width
　　cyScreen = Frame1.Height
　　
　　' Call CaptureWindow to capture the entire frame give the handle
　　' and return the resulting Picture object.
　　Set CaptureFrame = CaptureWindow(hWndScreen, False, 0, 0, cxScreen, cyScreen)
End Function

・ツリー全体表示


	【78518】Re:ユーザーフォーム上の画像保存方法

ゆうじん - 16/10/26(水) 8:33 -


	引用なし

	パスワード

▼β さん：

やはり難しいですか・・・

一度、Frameを使ってみます。
ご回答ありがとうございました。

・ツリー全体表示


	【78517】Re:ユーザーフォーム上の画像保存方法

β - 16/10/25(火) 20:59 -


	引用なし

	パスワード

▼ゆうじんさん：

どうなんでしょうね。

Imageコントロールでは難しいかもしれません。
かといって、そのあたり、素人ですので詳しくないのですが
Frameコントロールであれば、コンテナとして、その上に配置した　TextBox等も
内包します。

Frameのハンドルは

Private Declare Function WindowFromAccessibleObject Lib "oleacc" ( _
　　　ByVal pacc As Object, _
　　　ByRef phwnd As Long) As Long

を宣言しておいて

　　WindowFromAccessibleObject Frame1, hwnd

等で、変数 hwnd に取得できます。

このハンドルからFrameウィンドウを取得して、そのウィンドウの画面キャプチャを行えば
なにかしら、元画像と、その上にある TextBox が含まれたイメージを取得できると思います。

ただ、申し上げたように、そのあたり詳しくないので。

「vba api windowのキャプチャー」あたりで検索すると参考ページもでてくるとは
思いますが。

これ以上のお手伝いは、私には無理なので、上級者さんの回答をお待ちください。

・ツリー全体表示


	【78516】Re:ユーザーフォーム上の画像保存方法

ゆうじん - 16/10/25(火) 20:10 -


	引用なし

	パスワード

▼β さん：

>何を画像として保存したいのでしょう？
>ユーザーフォーム全体ですか？

チェックボックスと画像が重なって写っているものを画像として保存したいです。
ユーザーフォーム全体ではなく、画像の箇所のみが欲しいです。

>はい。これはImage1の中の画像を名前を付けて保存しているコードですが

だから、チェックボックスが写っていない画像だったのですね。

説明が下手で申し訳ありません。

・ツリー全体表示


	【78515】Re:ユーザーフォーム上の画像保存方法

β - 16/10/25(火) 19:08 -


	引用なし

	パスワード

▼ゆうじんさん：

>以下の方法を試してみましたが、画像のみが取得されました。

はい。これはImage1の中の画像を名前を付けて保存しているコードですが
それでは

>イメージ的には、画像のハードコピーをとるような感じです。

という目的に合わないのですか？

何を画像として保存したいのでしょう？
ユーザーフォーム全体ですか？

・ツリー全体表示


	【78514】ユーザーフォーム上の画像保存方法

ゆうじん - 16/10/25(火) 18:25 -


	引用なし

	パスワード

お世話になっております。

ユーザーフォームにImageコントロールを配置し、画像を表示させています。
その画像の上にテキストボックスを重ねて配置しております。
この状態をJPEG形式で保存したいのですが、どうすれば実現できますでしょうか。
イメージ的には、画像のハードコピーをとるような感じです。

以下の方法を試してみましたが、画像のみが取得されました。
SavePicture UserForm1.image1.Picture, "C:\hoge.jpg"

よろしくお願いいたします。

・ツリー全体表示


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

196 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free