Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
65 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【81176】Re:ユーザーフォームのリストボックスに...
お礼  投稿者  - 20/2/18(火) 12:49 -
引用なし
パスワード
   丁寧に教えていただきありがとうございます。
質問するのも初めてだったのでいろいろと不適切な部分があり
もうしわけありませんでした。
思い通りの動作を確認できました！
ありがとうございます。
・ツリー全体表示
【81175】Re:ユーザーフォームのリストボックスに...
回答  γ  - 20/2/18(火) 11:10 -
引用なし
パスワード
   Columnプロパティを使うとよいと思います。
参考にしてください。

Private Sub CommandButton1_Click()
　　Dim wb As Workbook
　　Dim ws As Worksheet
　　Dim flg As Boolean
　　Dim myData, myData2()
　　Dim i As Long, j As Long, cn As Long
　　Dim LastRow As Long

　　'対象Bookの指定
　　For Each wb In Workbooks
　　　　If wb.Name = "DATA.xlms" Then
　　　　　　flg = True
　　　　　　Exit For
　　　　End If
　　Next

　　If flg = False Then
　　　　Set wb = Workbooks.Open(ThisWorkbook.Path & "\DATA.xlsm")
　　End If

　　'配列の作成
　　For Each ws In wb.Worksheets
　　　　With ws
　　　　　　LastRow = .Cells(Rows.count, 1).End(xlUp).Row
　　　　　　myData = .Range(.Cells(1, 1), .Cells(LastRow, 7)).Value
　　　　End With

　　　　For i = LBound(myData) To UBound(myData)
　　　　　　If myData(i, 4) Like "*" & TextBox1.Value & "*" Then
　　　　　　　　cn = cn + 1
　　　　　　　　ReDim Preserve myData2(1 To 4, 1 To cn)
　　　　　　　　myData2(1, cn) = myData(i, 1)
　　　　　　　　myData2(2, cn) = myData(i, 3)
　　　　　　　　myData2(3, cn) = myData(i, 4)
　　　　　　　　myData2(4, cn) = myData(i, 6)
　　　　　　End If
　　　　Next i
　　Next

　　'
　　With ListBox1
　　　　.ColumnCount = 4
　　　　.ColumnWidths = "50;200;200;50"
　　　　.Column() = myData2
　　End With

　　wb.Close SaveChanges:=False
End Sub

なお、投稿にあたっては、手打ちせずに、
VBE(エディタ−）にあるコードをそのままコピーペイストしてください。
手打ちミスの修正までするのは無駄です。議論が噛み合わないこともあります。

また、冒頭に Option Explicit として、
未宣言の変数が無いようにしてください。
オプション設定を変更することで、自動的に、
Option Explicit を書き込む設定にしておくことを推奨します。
・ツリー全体表示
【81174】ユーザーフォームのリストボックスに別ブ...
質問  初心者です。  - 20/2/17(月) 21:58 -
引用なし
パスワード
   ユーザフォームのテキストボックスの文字を別ブックの全てのシートから検索し
必要な列だけをリストボックスに表示したいです。
現在、ネットで検索してなんとか
別ブックの指定したｼｰﾄから検索し表示は出来たのですが・・・。


Private Sub CommandButton1_Click()

　　Dim wb As Workbook
　　Dim flg As Boolean
　　Dim myData,myData2(),myno
　　Dim i As long,j As long,cn As long

　　ForEach wb In Workbooks
　　If wb.Name="DATA.xlms"Then
　　fig=True
　　Exit For
　　End If
　　Next

　　If fig=False Then
　　Workbooks.Open ThisWorkbook.Path&"\DATA.xlsm"
　　End If

　　With Worksheets("K2")
　　lastRow=.Cells(Rows.Count,1).End(xlUp).Row
　　myData=.Range(.Cells(1,1),.Cells(lastRow,7)).Value
　　End With

　　ReDim myData2(1 To lastRow,1 To 4)
　　Fori=LBound(myData)To UBound(myData)
　　If myData(i,4)Like"*"&Textbox1.Value&"*"Then
　　cn=cn+1
　　myData2(cn,1)=myData(i,1)
　　myData2(cn,2)=myData(i,3)
　　myData2(cn,3)=myData(i,4)
　　myData2(cn,4)=myData(i,6)
　　End If
　　Next i

　　With リストボックス
　　.ColumnCount=4
　　.ColumnWidths="50;200;200;50"
　　.List
　　End With

　　Workbooks("DATA.xlsm").Close SaveChanges:=False

　　End Sub
別ブック内の全てのｼｰﾄから検索し表示したいです。
ｼｰﾄは５つあります。
どのように記述すればよいかご教示お願いします。
・ツリー全体表示
【81173】Re:複数シートのコピー（EXCEL2010）
お礼  初心者  - 20/2/17(月) 18:10 -
引用なし
パスワード
   ▼初心者 さん：

別の掲示板にうつります。すみません。ありがとうございました。
・ツリー全体表示
【81172】Re:複数シートのコピー（EXCEL2010）
質問  初心者  - 20/2/17(月) 17:58 -
引用なし
パスワード
   ▼よろずや さん：
>▼初心者 さん：
>>複数選択した状態でコピーするマクロを作ったのですが
>
>それを提示した方が回答が付きやすいですよ。

すみません。体調を崩して寝込んでおり返事が遅れてしまいました。

会社でどのようなマクロを作っていたかわからなくなり、
また自宅も2010ではないので再現できないのですが
新たに以下のようなマクロを作って別の問題に直面いたしました。

以下のマクロだと
初期に選択されているシートにより挙動に問題が発生します。
（全て選択されているとそのままになる、testが選択されていると繰り返さない）
原因と訂正方法を知りたいです。
何卒よろしくお願いいたします。


Sub テスト()

Dim ws As Worksheet

　For Each ws In Sheets
　　　　If ws.Name <> "test" And ws.Name <> "test2" Then ws.Select Replace:=False
　Next ws
　　
　ActiveWindow.SelectedSheets.Copy
End Sub
・ツリー全体表示
【81171】Re:複数シートのコピー（EXCEL2010）
発言  よろずや  - 20/2/15(土) 16:52 -
引用なし
パスワード
   ▼初心者 さん：
>複数選択した状態でコピーするマクロを作ったのですが

それを提示した方が回答が付きやすいですよ。
・ツリー全体表示
【81170】複数シートのコピー（EXCEL2010）
質問  初心者  - 20/2/14(金) 12:46 -
引用なし
パスワード
   1つのファイルに、2つの固定シートと、数と名前が可変のシートが複数付いたファイルがあります。シート数はあわせて4つ以上は存在します。
このファイルを開いた状態で、2つの固定シート以外を新しいファイルにコピーするマクロが作りたいです。
複数選択した状態でコピーするマクロを作ったのですが、EXCEL2010のため、複数同時にシートをコピーできないようでエラーとなりました。
・ツリー全体表示
【81169】リダイレクト画面にパスワード値を設定し...
質問  さんちゃん  - 20/1/31(金) 13:30 -
引用なし
パスワード
   テストデータの設定画面
１．表示されたHTMLにデータ設定後
２．Submitボタン

確認画面
３．表示された設定値の確認画面で（何もしないで）Submitボタン
４．3.SubmitボタンクリックでHTTP POSTでアプリケーションを呼び出してリダイレクト先URLを取得し 取得したURLにブラウザ経由でリダイレクト

５．リダイレクト画面にパスワードを設定
６．Submitボタンをクリック


上記のような流れでVBAを作成したいのですが、５．以降の処理の仕方がわかりません。
（４．までは自力で作成できていて、リダイレクト画面を表示するところまでできています。）

VBA初心者です。
どなたかわかりやすく教えていただけると助かります。

書いているコードは以下のようなコードです。
Sub Test()
　　
Application.ScreenUpdating = False
　　
'IEの起動
Dim objIE As Object

Set objIE = New InternetExplorerMedium

objIE.Visible = True
　　　　
　　　　
　　objIE.navigate "127.O.O.1:8080/Hoge/Entry"　' このURLを任意に変更
　　　　
　　' ページの表示完了待ち｡
　　While objIE.readyState <> 4 Or objIE.Busy = True
　　　　DoEvents
　　Wend

　　
　　On Error Resume Next　　　'値がないとエラーが出るので、エラー回避用
　　　
　　 Dim A As Object
　　　　
　　For Each A In objIE.document.getElementsByTagName("INPUT") '1.FOR EACH でINPUTをすべて抜き出す。
　　　
　　　　If A.Name = "CardNumber" Then A.Value = Range("A1") '2.IF分で入力したい要素を見つけて3.valueで代入。
　　　　
　　Next
　　　
　　On Error GoTo 0
　
　 objIE.document.forms(0).submit


　　Set htmlDoc = Nothing 'HTMLをいったん破棄
　　
　　
　　' ページの表示完了待ち｡
　　While objIE.readyState <> 4 Or objIE.Busy = True
　　　　DoEvents
　　Wend
　　
　　Set htmlDoc = objIE.document 'submit後のページのHTMLを読み込む

　 objIE.document.forms(0).submit


'*****
'以降リダイレクトされた画面でどのように処理するれば良いかわかりません。
'やりたい事は、ここでパスワードを設定してSubmitをクリックすることです。
'*****


End Sub
・ツリー全体表示
【81167】Re:Excelからメールを自動作成するマクロ...
質問  Questioner  - 20/1/24(金) 14:50 -
引用なし
パスワード
   γ さん

早速ご回答いただきありがとうございます。
オートフィルタは試していたのですが、必要な行だけチェック・表示させた状態でも、表示・非表示に関わらず全ての行に対して処理をされてしまいます。

フィルタで選択した行のみ指定することが出来れば一番簡単で良いのですが、その処理をさせるためにはどのように記述を追加すれば良いでしょうか？

どうぞよろしくお願いいたします。
・ツリー全体表示
【81166】Re:Excelからメールを自動作成するマクロ...
発言  γ  - 20/1/24(金) 8:46 -
引用なし
パスワード
   こんにちは。

(1)まずは、重複を除いた宛先データの表を作ります。
　 フィルタオプションでも、重複の排除ボタンでもよいでしょう。
(2)上記の各行ごとに、
　 オートフィルタを実行して、対応するデータを抽出し、
　 それに対して本文文字列を作成すればよいと思います。

まずは、質問者さんがトライされることをお奨めします。
・ツリー全体表示
【81165】Excelからメールを自動作成するマクロに...
質問  Questioner  - 20/1/23(木) 20:14 -
引用なし
パスワード
   こんちには。初めて投稿させていただきます。

以下のサイトを参考に、Excelのデータからメールを自動作成するマクロを作成しています。
moripro.net/vba-outlook-createmail

質問は2点です。

1.
データの行数分、メールを一括で作成する方法は理解できたのですが、複数行にわたって同じメールアドレスがあった場合も、1行に対し1件メールを作成してしまいます。

同じメールアドレスが続く場合、データをまとめメールを1件だけ作成するように制御することは可能でしょうか？

例えば以下の表でマクロを実行した場合、
「佐藤さん宛てに3件」＋「鈴木さん宛てに1件」＋「田中さん宛てに1件」
＝合計5件のメールが作成されてしまいますが、

--------------------------------------
宛先（To）　　　　氏名　使用日　　金額
--------------------------------------
sato@xxx.co.jp　　佐藤　2018/7/1　100
sato@xxx.co.jp　　佐藤　2018/7/2　200
sato@xxx.co.jp　　佐藤　2018/7/3　300
suzuki@xxx.co.jp　鈴木　2018/7/4　400
tanaka@xxx.co.jp　田中　2018/7/5　500
--------------------------------------

佐藤さん宛ては3行分の情報を1件のメールにまとめ、以下のようにメールが3件作成されるようにしたいです。

------------------------------------
【宛先】sato@xxx.co.jp

【本文】佐藤さん
　　　　使用日：2018/7/1　金額：100
　　　　　　　　2018/7/2　金額：200
　　　　　　　　2018/7/3　金額：300
------------------------------------
【宛先】suzuki@xxx.co.jp

【本文】鈴木さん
　　　　使用日：2018/7/4　金額：400
------------------------------------
【宛先】tanaka@xxx.co.jp

【本文】田中さん
　　　　使用日：2018/7/5　金額：300
------------------------------------

2.
すべての行に対して処理を繰り返すのではなく、特定の行のみに対して処理をしたい場合、どのように変更すれば良いでしょうか？

VBA超初心者のため質問の仕方が適切なのかも分からないのですが、不足している情報があれば教えてください。
どのように記述をすれば良いのか、ご教示いただけますと幸いです。
・ツリー全体表示
【81164】Re:ユーザー定義関数、シート上とコード...
発言  hoyahoyamachine  - 20/1/13(月) 0:02 -
引用なし
パスワード
   ▼Jaka さん：
>▼hoyahoyamachine さん：
>
>>ユーザー定義関数をワークシート上で使用する場合に[F8]は使えるのでしょうか？
>
>Function プロシジャーのコード内にブレークポイントを設けておけば、
>数式を書き込んだ時にそこで止まるけど。
>
>でも、Function プロシジャーにする前に、Sub プロシジャーで、まともに動くまで確認します。

はい、確かにそうですね。
Subプロシジャでは問題なく動くのですけれど、今回ワークシート上では休日をカウントしなかったんです。
一時しのぎの回避策で、シートモジュールのChangeイベントを利用して標準モジュールのFunctionプロシジャをコールする手段をとり、問題ない動作を確認したのですが、ユーザー定義関数としてFunctionプロシジャを使う場合、参照先は引数にしないといけない、ってことがわかりました。
・ツリー全体表示
【81163】Re:ユーザー定義関数、シート上とコード...
発言  Jaka  - 20/1/12(日) 22:01 -
引用なし
パスワード
   ▼hoyahoyamachine さん：

>ユーザー定義関数をワークシート上で使用する場合に[F8]は使えるのでしょうか？

Function プロシジャーのコード内にブレークポイントを設けておけば、
数式を書き込んだ時にそこで止まるけど。

でも、Function プロシジャーにする前に、Sub プロシジャーで、まともに動くまで確認します。
・ツリー全体表示
【81162】Re:ユーザー定義関数、シート上とコード...
発言  hoyahoyamachine  - 20/1/12(日) 16:13 -
引用なし
パスワード
   ▼Jaka さん：
>>私なら、この辺↑で、一致しない日付を書き出して確認します。
>
>一致するものかも、それでも解らなければ両方。

ご回答ありがとうございました。
CurrentRegionがどうも怪しかったようで、Yさんのご指摘で解決の方向です。

ユーザー定義関数をワークシート上で使用する場合に[F8]は使えるのでしょうか？
・ツリー全体表示
【81161】Re:ユーザー定義関数、シート上とコード...
お礼  hoyahoyamachine  - 20/1/12(日) 16:06 -
引用なし
パスワード
   ▼γ さん：
>For Each h In wsHoliday.Range("A2:A13")と明示的に書いておけば、
>引数として渡さなくてもよかったですね、どうも失礼。

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

CurrentRegionを使わずに、明示的に書くと確かに正しい答えになりました。
そこで、休日の範囲を引数として、

=wfEnDate([@PerDay],[@Quantity],[@StDate],OFFSET(Holiday!$A$1,0,0,COUNTA(Holiday!$A:$A)-1,1))

で休日の増減に対応できました。
・ツリー全体表示
【81160】Re:ユーザー定義関数、シート上とコード...
発言  Jaka  - 20/1/9(木) 3:24 -
引用なし
パスワード
   >私なら、この辺↑で、一致しない日付を書き出して確認します。

一致するものかも、それでも解らなければ両方。
・ツリー全体表示
【81159】Re:ユーザー定義関数、シート上とコード...
発言  Jaka  - 20/1/9(木) 1:47 -
引用なし
パスワード
   私的な意見ですが、
表がどうなっているのかわからないけど、
CurrentRegion なんか使って大丈夫なのかな？
という事と、

>　　　　　　If d = h.Value Then　'日付と休日が一致すれば
>　　　　　　　　ProdDays = ProdDays + 1　'生産日数を一日増やす
>　　　　　　End If

私なら、この辺↑で、一致しない日付を書き出して確認します。
ひたすら、F８キー押しまくる時もありますけどね。

時折、こんな物を書き足して、途中からＦ８で確認します。

ct = ct + 1
if ct = 100 then
　 a = 0　　←ここにブレークポイント
end if
・ツリー全体表示
【81158】Re:ユーザー定義関数、シート上とコード...
発言  γ  - 20/1/7(火) 21:56 -
引用なし
パスワード
   For Each h In wsHoliday.Range("A2:A13")と明示的に書いておけば、
引数として渡さなくてもよかったですね、どうも失礼。
・ツリー全体表示
【81157】Re:ユーザー定義関数、シート上とコード...
回答  γ  - 20/1/7(火) 20:42 -
引用なし
パスワード
   Excel のユーザー定義関数の制限について
ht tps://support.microsoft.com/ja-jp/help/170787/description-of-limitations-of-custom-functions-in-excel
には、
>正しい計算を行うには、計算で使用されるすべての範囲を引数として関数に渡す必要があります。
と記載されています。
祝日のテーブルを引数として追加すれば、両者は一致すると思います。
・ツリー全体表示
【81156】ユーザー定義関数、シート上とコード内の...
質問  hoyahoyamachine  - 20/1/7(火) 11:50 -
引用なし
パスワード
   こんにちは。
初めて質問いたします。

ユーザー定義関数で、シート上での結果とコード内での結果に違算があり、原因がつかみかねています。

マイクロソフトのユーザー定義関数の制限によるといろいろ書いてありますが、
特段プロパティもメッソドも使わず、セル値を変更することもなく、ただ参照しているだけのコードです。具体的には以下の通りです。

ワークシートDB　とワークシートHolidayがあり、DBにはテーブルがセットされ、以下のフィールドとデータがあります。

ワークシートDBの一部
PerDay　 Quantity　 StDate　 EnDate
14.4　　　 400　　　20/1/7　 =EnDate([@PerDay],[@Quantity],[@StDate])

ワークシートHoliday、セルA1から下方へセット
Holiday
2020/1/1
2020/1/2
2020/1/3
2020/1/4
2020/1/5
2020/1/12
2020/1/19
2020/1/25
2020/1/26
2020/2/1
2020/2/2
2020/2/9

Function EnDate(ByVal PerDay As Single, Quantity As Single, StDate As Date) As Date
'日産、生産数量、開始日から終了日を休日リストを参照しつつ求める
Dim wsHoliday As Worksheet
Dim ProdDays As Single, d As Date, h As Range
　　ProdDays = Quantity / PerDay '生産日数をセット
　　Set wsHoliday = Worksheets("Holiday")　'ワークシートのセット
　　d = StDate　'基点をセット
　　Do Until ProdDays <= 0　'生産日数が0以下になればDoLoop終了
　　　　For Each h In wsHoliday.Cells(1, 1).CurrentRegion '休日それぞれについて
　　　　　　If d = h.Value Then　'日付と休日が一致すれば
　　　　　　　　ProdDays = ProdDays + 1　'生産日数を一日増やす
　　　　　　End If
　　　　Next h
　　　　ProdDays = ProdDays - 1　'ループ一回ごとに生産日数を一日減らす
　　　　d = d + 1　'次の日をセット
　　Loop
　　EnDate = d　'終了日を返す
End Function

結果、シート上では2020/2/4、コード実行の結果は2020/2/11　でした。
シート上では休日が加算されていない感じですね。

原因がつかめないので、ChangeイベントでEnDateを実行するようにしたのですが、今後の知見のためにもご教授いただきたくよろしくお願いいたします。
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
65 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free