Visual Basic（VBA）(18ページ目)

VBAマクロでデータ集計の結果を出すマクロの記載方法を教えてほしい、この結果が出た時にフォントの色を変更したいがその時のVBAコードの組み方を教えてほしい、このエラーメッセージの解決方法を知りたい等こちらに参考情報があるかもしれません。

回答数

気になる

シート間で同じ値があったら指定範囲をコピーして貼り付け

シート1のA列とシート2のB列に同じ値があった場合シート2の同じ値のあるセルから紐づけられた範囲（画像の場合はセルC8からN10）をシート1のD8に数式と数値の書式で貼り付けしたいです。セルを結合している箇所があります。シート1の貼り付け範囲とシート2の選択範囲は同じフォーマットです。お詳しい方、宜しくお願いいたします。

質問日時: 2022/11/07 08:01 質問者: さわ子

解決済

1

1
エクセルVBA コードが同じでもファイルによって処理速度が大きく変わるのはなぜ

テキストエディタに保存してあるVBAのコードを、必要に応じてエクセルファイルにコピペ、対象の行数など細かい点を修正して使いまわしています。繰り返し処理を行う行数はファイルによって異なりますが、数としてはそれほど変わりません。しかしファイルごとに処理完了までのスピードが大きく異なります。早ければ10～20秒ほどで終わりますが、ファイルによっては何分も待ちます。その理由が知りたいです。 VBAを走らせるPCも、使用しているエクセルのバージョンも同じです。バックグラウンドで起動しているソフトも、だいたいいつもメーラーとブラウザです。ひとつ思い当る相違点は処理をする列「以外」の列のデータ量ですが、作業をする列以外のデータ量は処理速度に影響しますか？

質問日時: 2022/11/06 21:34 質問者: bari_saku

解決済

5

0
リストボックス選択

いつもお世話になっておりますわかる方おしえてくれませんでしょうか添付ファイルのようにコマンドボタンを押下すると　あらかじめせっていされた　遠藤　加藤だけを　選択する方法ありますでしょうか。

質問日時: 2022/11/06 09:12 質問者: りんごプリン

ベストアンサー

1

1
リストポックスについて

いつもお世話になっておりますやりたいことは、ユーザーフォームを起動したら、近藤を選択状態にしておきたいのです。検索してしらべましたが、.ListIndex = 2 で行けるのかなと思いましたが、だめでした。わかる方おしえてくれませんでしょうか Private Sub UserForm_initialize() With ListBox1 .Font.Size = 14 .AddItem "近藤" .AddItem "遠藤" .AddItem "佐藤" .AddItem "工藤" .ListIndex = 2 End With End Sub

質問日時: 2022/11/05 20:48 質問者: りんごプリン

ベストアンサー

2

2
※初心者ですマクロVBAについて

Sub ボタン76_Click() If Len(Worksheets("Sheet1").Range("D12").Value) > 0 Then Worksheets("Sheet2").Select Ln = Range("I1048576").End(xlUp).Row Cells(Ln + 1, 9) = Worksheets("Sheet1").Range("B12") Cells(Ln + 1, 11) = Worksheets("Sheet1").Range("D12") Worksheets("sheet1").Select Else End If マクロでのシステムを試行錯誤しながら作っているのですが、『sheet1のセルD12が「０」であるときsheet１のそのセルとB12のセルを、　sheet2の一番下のセルへとそれぞれ入力したあと、sheet１へ戻る』という式を作っています。以前作った時はエラーが出なかったのですが、久しぶりに使った時に 1004のオブジェクトエラーがでました。どこがエラーの原因なのか、解決策が分かりません…。

質問日時: 2022/11/05 12:53 質問者: moasdfsgre

ベストアンサー

3

1
エクセルＶＢＡで『Ａ列』に新規で数値を入力し『Ｂ列』から右方向の空白セルにその値を貼り付ける方法

エクセルＶＢＡの初心者です。例えば『Ａ列』の１行目のセルに１０、２行目のセルに２０、３行目のセルに３０という様に新規で数値を入力した後にマクロを実行するとその値をコピーしその行の右方向の列で最初の空白セルにその値を貼り付けたいのですが、どのようにプログラムを組めば良いのか分かりません。詳しい方、お手数をお掛けしますが教えて下さい。Ａ列　Ｂ列　Ｃ列　Ｄ列　Ｅ列　Ｆ列１０　１５　３０　★ ２０　２５　５５　６０　８０　★ ３０　３０　４０　２０　★ ４０　１０　２０　５０　４０　★ ５０　２０　３０　★ ★印の空白セルにその行のＡ列の数値が貼り付けられる様にお願いします。尚、行数は５０００行程あります。

質問日時: 2022/11/05 08:37 質問者: TAKA6731462

ベストアンサー

4

0
エクセル VBA 条件によるセル点滅お詳しい方ご教授をお願いします。 Excelファイルにて現

エクセル　VBA 条件によるセル点滅お詳しい方　ご教授をお願いします。 Excelファイルにて現在下記のことを実施しようと思っています。 ※注意喚起表示をしたい例　セルB3にサンプル1と表示されると D5からD7　及びE5からE7のセルが赤白で点滅セルB3にサンプル2と表示されると C5からC7　及びF5からF7のセルが赤白で点滅塗りつぶすだけなら条件付き書式で対応できたのですが、点滅がうまくいきませんネットで調べるとVBAぐらいしか対応できなさそうなのですが、やり方をご存じの方　アドバイスをお願いします。

質問日時: 2022/11/03 15:53 質問者: kazunoko1689

解決済

1

0
VBA アドインについてお詳しい方ご教授をお願いします。相談事項現在以下の対応を実施した所、

VBA アドインについてお詳しい方　ご教授をお願いします。相談事項現在以下の対応を実施した所、⑥でマクロが正常に動きません。 ①オブジェクトにマクロを登録したファイルを作成　 ②マクロ自体はアドイン化を行い、オブジェクトクリック後はアドインのマクロを参照するように設定 ③自分のPCで①ファイルが正常稼働する事を確認 ④アドインを他人に配布 ⑤配布先の人はExcelアドインに作成アドインを登録及びチェックを実施 ⑥実際に①ファイルを他人に使用してもらおうとすると①オブジェクトマクロの参照がC:¥Users・・xlam'!マクロ名と変化しており、実際にプログラムを動かそうとすると申し訳ありません。同じ名前のブックを同時に開くことはできません。とエラー表示されます。　解決する方法何かありませんでしょうか。

質問日時: 2022/11/02 16:53 質問者: kazunoko1689

ベストアンサー

1

0
VBAで重複した値のセルに色付けをしたい

Sheet1に情報が入力されています(D列2行以下にシリアル) 検品作業でSheet2のB列4行以下にシリアルをスキャンして入力します D列以降にSheet1の情報がコピーされるようにしてあります下記のコードに追加してSheet2に入力したシリアルをみてSheet1の同じシリアルのセルに色付けできませんでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub ''「シリアル№」の行を検索する。 Dim iRow As Long With Sheets("sheet1") On Error Resume Next iRow = 0 iRow = Application.WorksheetFunction.Match(Target.Value, .Range("D:D"), 0) On Error GoTo 0 If iRow <= 0 Then Exit Sub ''対象行をコピーする。 Application.EnableEvents = False .Range(.Cells(iRow, "E"), .Cells(iRow, "T")).Copy Cells(Target.Row, "D").PasteSpecial Paste:=xlPasteValues Application.EnableEvents = True 'カーソルの位置指定 ActiveCell.Offset(1, -2).Activate End With End Sub

質問日時: 2022/11/02 16:12 質問者: ka-.-ji

ベストアンサー

1

0
Selenium webbrowserで開いているwebサイトのタイトル取得

いつも大変お世話になります表題通りなのですが、vbaでご教示頂けないでしょうか？ edgeで開いてるwebサイトのタイトルを取得したいです。

質問日時: 2022/11/02 14:50 質問者: 太郎です

ベストアンサー

1

0
特定の文字を簡単な操作で半角スペースに変換するか削除したい

Office 2019です。 WordとExcelのファイルで、特定の文字に囲まれた部分とその特定の文字を、簡単な操作で半角スペースに変換するか、すべて削除することは可能でしょうか。マクロで可能であればその構文を教えてくださいますか。各文書の“表”にもその文字列はあります。次に例と、勝手ながら条件やお願いがあります。例： ???文字列??? ???が特定の文字、“文字列”が文字です。特定の文字は基本的に決まった文字の組み合わせですが、変更になる事があります。文字列は半角全角混在の自然文で、文字数も決まっていません。条件やお願い：（マクロわかりません）いち文書中に半角スペースに変換したい部分と削除したい部分が混在していると考えられますので、該当箇所を選択して半角スペース変換か削除かを選べるようにするのが安全なのかなと思います。マクロを使用するのであれば、ファイルにマクロを埋め込んだり、マクロを使用した痕跡や履歴が残らないとよいです。文字を半角スペースに変換する際、全角１文字は半角スペース2文字分に変換してくれるとありがたいです。一度の操作で“文字列”を置換なり削除し、次の操作で???や???????を削除するというのでもいいと思いますが、良い方法をご提案いただければ幸いです。ネットでまず「Wordで特定の文字を削除する」を探して作り込んでみましたが、うまくいきませんでした。

質問日時: 2022/11/01 10:35 質問者: tebentou

解決済

2

0
Excel VBAでAA(BBB) → BBB.AA に置換したい

大量の計算式の中に含まれている AA(BBB)やSS(CCC)のような、丸かっこで囲われた文字列を抽出し、かっこの前にある文字列を後ろにくっつけてたいです。※文字列と文字列の間にピリオド(.)を追加したい。置換前　AA(BBB) 置換後　BBB.AA このような置換をしたいのですが、1つのセルの中に複数個このような置換をしたい文字列が出てきます。例）置換前 A = 100.0 QQ(ABC) = ZZ(DEF) - 50.0 IF(QQ(ABC) < 0.0) THEN SS(ABC) = 100.0 END IF ↓ 例）置換後 A = 100.0 ABC.QQ = DEF.ZZ - 50.0 IF(ABC.QQ < 0.0) THEN ABC.SS = 100.0 END IF どのように組めば上記のような置換ができるでしょうか？よろしくお願いします。

質問日時: 2022/10/30 13:59 質問者: 栞23

ベストアンサー

2

1
VBA 画面上のカーソルに文字数字を入力するコードを教えて下さい

画面上の指定したマウスの位置に文字数字を入力したい。例えば、あるアプリの入力枠にカーソルをもってゆき、そこに文字数字をＶＢＡから入力したいのです。もちろんアプリご画面は最大化する等して入力枠の位置が変わらないようにしておきます。カーソルの位置は下記コードで指定できる事は調べました。 Sub マウスで画面の任意の位置をクリック() SetCursorPos 100, 200 'X=100,Y=200の地点にカーソルを移動 mouse_event &H2 'マウス左ボタンを押す mouse_event &H4 'マウス左ボタンを離す End Sub よろしくお願いします。

質問日時: 2022/10/30 10:31 質問者: ニックネーム船長

解決済

1

0
「○」が付いてる祝日以降の「A」を検索・抽出したいです。例えば、東京都の場合、5/3に「○」が付い

「○」が付いてる祝日以降の「A」を検索・抽出したいです。例えば、東京都の場合、5/3に「○」が付いているので、祝日以降のAである5/7の「A3」を、大阪府の場合、5/4に「○」が付いているので、祝日以降のAである5/6の「A2」を抽出し、それぞれの日に抽出したAを入力したいです。 win10、Excel2016 これをVBAでやりたいです。よろしくお願いします。

質問日時: 2022/10/30 03:04 質問者: mionosuke_21

ベストアンサー

7

0
初めてマクロを入力しますが、テキストとおりに入力したのに構文エラーです。修正を教えてください。

テキストとおりに入力したのに構文エラーです。修正を教えてください。 Sub CreateLink() Dim addRow As Integer Dim wsName As String Dim rngAddr As String Dim supTxt As String wsName = ActivSheet.Name rngAddr = Selection.Address supTxt = InputBox("リンクの補足を入力してください") With Worksheets("リンク") addRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 .Hyperlinks.Add_ Anchor:=.Cells(addRow,"B"),_ Address:="",SubAddress:=wsName& "!" &rngAddr,_ 　TextToDisplay:="●" .Cells(addRow, "C").Value = supTxt .Cells(addRow, "D").Value = wsName .Cells(addRow, "E").Value = rngAddr End With End Sub

質問日時: 2022/10/28 11:18 質問者: Chika0610

解決済

3

0
excel2016でリストからカレンダーに内容を反映させたいです

excel2016で質問です。検診の予約のため受付簿を作成しており、枠が決まっているため年間カレンダーに名前を入れています。検診のシート（受付簿）から年間カレンダー（４月）へ該当する検診を反映させたいのですが、素人のため大変困っております。教えていただけませんでしょうか。年間カレンダーは６種別となっていまして、１日に特定健診、一般健診で併せて２名、子宮がん検診６名、乳がん○○県、乳がん○○市、乳がん個人で１名ずつ、その他健診（一般健診（採用）、じん肺、アスベスト、肝炎ウィルス、結核）で６名の枠をとっています。風しん検査は診察枠をとらないのでカレンダーに反映していません。子宮がん検診のＨＰＶ検査、エコー検査、対がん検査、乳がんエコー検査は必ず診察日にしてもらうので、カレンダーには反映していません。（同一人物で、子宮がん検診と子宮エコーを申し込んでも枠は６のうち２つではなく１つです。但し同一日に乳がん検診など、ほかの６種の健診に申し込みがあれば、その健診の枠を１つ埋めています。）同一日の受診者がいたら枠を取るようにしています。予約が入ったら、健診実施日で未来日が一番上になるように１行ずつ挿入して入力しています。カレンダーのほうは、Ｙ１に年を入れてB4にDATE(Ｙ１,4,1)と入れてＢ５からは下にＢ4+1、Ｂ５+1、、、でオートフィルコピーを縦に３月３１日までしています。各月に４月、５月、、、と１行ずつ入れていますので、オートフィルの日付は月表示の行は飛ばして前のセルに+1して作成しています。曜日はTEXT(C4,"aaa")で取得しています。受付簿から、現年度１年間分のカレンダーに反映し表示ができれば、後、何人枠が残っているか一目でわかりますので、ありがたいです。半年後の予約なども受けます。受付簿自体は現在２０００行分位（平成３１年より）ありますが、カレンダーのほうは過去の年度（今年度が終了したら）は反映されなくとも受付簿のデータが残っているので（積み重なっていくので）問題ないです。誠にややこしいのですが、ご教示いただけますと助かります。初めて知恵袋で質問させていただきます。もし、ルール違反や不明な点が、ありましたら、申し訳ありません。

質問日時: 2022/10/27 15:32 質問者: しんぼうくん

解決済

2

0
VBA処理追加こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく

VBA処理追加こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてください。前回回答いただいた方追加で申し訳ないのですが上の画像（元データ）の黄色のセルの文字を下の画像（結果）のように名前に関連させて表示させたいのですがどうすればよろしいでしょうか？ご教示お願い致します。 Option Explicit Public Sub ユークリッド距離順() Const BA1 As Long = 1000 '表縦の倍率 Const BA2 As Long = 100 '表横の倍率 Const BA3 As Long = 10 '表高の倍率 Const BA4 As Long = 1000 '裏縦の倍率 Const BA5 As Long = 100 '裏横の倍率 Const BA6 As Long = 10 '裏高の倍率 Dim sh1 As Worksheet Dim sh2 As Worksheet Dim dicT As Object Dim maxrow1 As Long Dim namerow As Long Dim wrow As Long Dim row2 As Long Dim name As String Dim d1 As Long, d2 As Long, d11 As Long, d12 As Long, d13 As Long, d21 As Long, d22 As Long, d23 As Long Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義 Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row ' If name = "" Then Exit Sub sh2.Rows("5:" & Rows.Count).ClearContents '5行目以降クリア namerow = 0 For wrow = 3 To maxrow1 If name = sh1.Cells(wrow, 1).Value Then namerow = wrow End If Next If namerow = 0 Then MsgBox (name & "が存在しません") Exit Sub End If 'ユークリッド距離の計算 row2 = 5 For wrow = 3 To maxrow1 If wrow <> namerow Then sh2.Cells(row2, 1).Value = sh1.Cells(wrow, 1).Value '表名前 sh2.Cells(row2, 4).Value = sh1.Cells(wrow, 1).Value '裏名前 d11 = (sh1.Cells(wrow, 2).Value - sh1.Cells(namerow, 2).Value) d12 = (sh1.Cells(wrow, 3).Value - sh1.Cells(namerow, 3).Value) d13 = (sh1.Cells(wrow, 4).Value - sh1.Cells(namerow, 4).Value) d21 = (sh1.Cells(wrow, 5).Value - sh1.Cells(namerow, 5).Value) d22 = (sh1.Cells(wrow, 6).Value - sh1.Cells(namerow, 6).Value) d23 = (sh1.Cells(wrow, 7).Value - sh1.Cells(namerow, 7).Value) d1 = d11 * d11 * BA1 + d12 * d12 * BA2 + d13 * d13 * BA3 d2 = d21 * d21 * BA4 + d22 * d22 * BA5 + d23 * d23 * BA6 sh2.Cells(row2, 2).Value = d1 '表距離 sh2.Cells(row2, 5).Value = d2 '裏距離 row2 = row2 + 1 End If Next 'ソート sh2.Range("A5:B" & row2 - 1).Sort key1:=sh2.Range("B5"), Order1:=xlAscending, Header:=xlNo sh2.Range("D5:E" & row2 - 1).Sort key1:=sh2.Range("E5"), Order1:=xlAscending, Header:=xlNo sh2.Rows("10:" & Rows.Count).ClearContents '10行目以降クリア MsgBox ("完了") End Sub

質問日時: 2022/10/27 09:57 質問者: 。ゆき

ベストアンサー

2

0
VBA ドロップダウンリストを残して値のみクリア

VBA初心者です。 VBAコードでデータの入力規則のドロップダウンリストを残したまま、値のみを削除する方法をご教示ください。「Range("指定セル").Value = ""」や「Range("指定セル") = ""」などいろいろと試してみましたが、値と一緒にデータの入力規則もクリアされ、ドロップダウンリストが使用出来なくなって困っています。データの入力規則（リスト）を残し、セルに表示されている値のみクリアする方法はありますでしょうか？

質問日時: 2022/10/27 05:42 質問者: kosuko

解決済

2

0
エクセルのVBAでダブルクリックでチェックを入れたあと

エクセルのVBAでダブルクリックでチェックを入れた後、もう一度ダブルクリックでセルの色を黄色にしてもう一度ダブルクリックでチェックを消してセルの色も消したいのですが、３つめのcaseの書き方が分かりません。どのように書けばよいでしょうか。よろしくご教示ください。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A1:AZ1000")) Is Nothing Then Exit Sub With Target Select Case .Value Case "" .Value = ChrW(&H2713) Case ChrW(&H2713) .Interior.Color = RGB(255, 255, 0) Case .Value = ChrW(&H2713) .Value = "" End Select End With End Sub

質問日時: 2022/10/26 20:30 質問者: dondon1179

ベストアンサー

1

0
重複データをまとめて合計を合算する

画像のように同じシートにある、C列からG列にある項目をV列からZ列に K列からO列にある項目をAB列からAF列に品名コード、生産者コード、品名が一致しているものに対して項目をまとめて、品名を昇順にして注文数の合計を反映させたいです。データは何行になるかわかりません最終行の基準はC列、K列先頭行は4行目から始まります。お詳しい方宜しくお願いいたします。

質問日時: 2022/10/25 20:25 質問者: さわ子

ベストアンサー

4

1
飛び地セルの空白判定

複数セルの空白の数を判定したいです。以下のように記載したのですが、エラーが出ます。ただ、Set cRange = Worksheets("input").Range("h9,r9,f15,f17")を、 Set cRange = Worksheets("input").Range("h9")のようにすると正しく動作します。（H9セルが空白なら１と表示されます）複数の飛び地になっているセルの指定が間違っているのでしょうか？ Dim cRange as Range Dim i as Long Sub test() Set cRange = Worksheets("input").Range("h9,r9,f15,f17") i = WorksheetFunction.CountBlank(cRange) MsgBox (i) End Sub

質問日時: 2022/10/24 15:54 質問者: 88suihou88

ベストアンサー

2

0
VBA チェックボックスの設定について

前回質問させていただいたのですが説明のコードを間違えて次のコードを載せていましたなので再質問させていただきます、前回の方で色々変更して行ったのですが有効にはなりますが無効の時に何も検索にヒットしなくなるだけになりました・・・現在は複数条件検索していますがもう一つ条件を足して（コマンドボックス5）検索をかけたいのですが何か良い方法ありませんでしょうか？例えばfoamのコマンドボックス５のところにチェック入れて有効になり外すと今まで通りの検索になるようにできればと思います Private Sub CommandButton3_Click() '検索ボタン Dim tbl As Variant Dim i As Long tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row) ListBox1.Clear ListBox2.Clear Dim dic As Object Set dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(tbl) If tbl(i, 2) = ComboBox3.Value And _ tbl(i, 10) = "" And _ tbl(i, 3) = ComboBox4.Value Then If tbl(i, 6) <> "" Then If Not dic.Exists(tbl(i, 6)) Then dic.Add tbl(i, 6), 0 With ListBox2 .AddItem tbl(i, 6) End With End If End If End If Next i Set dic = Nothing End Sub

質問日時: 2022/10/24 10:27 質問者: ka-.-ji

解決済

1

0
クラスデフォルトプロパティの作り方

ExcelVBAでクラスを作り、いくつかのプロパティを用意しました。その中で、よく使うプロパティをデフォルトとしたいですが、可能でしょうか。例えば、Rangeオブジェクトでプロパティを省略すると Valueプロパティと見なされるみたいなイメージです。

質問日時: 2022/10/23 11:41 質問者: ママチャリ

ベストアンサー

1

0
セルに値が入っていた時の処理

Q列のセルに何かしら値が入っていたら同じ行のＬ列とＭ列の値を消去したいです。範囲はA列の最終行までです。お詳しい方宜しくお願いいたします。

質問日時: 2022/10/22 19:23 質問者: さわ子

ベストアンサー

1

0
Excel VBA キーワードから列を取得して、さらに空欄行を非表示にする

はじめて質問させていただきます。よろしくお願いいたします。【やりたいこと】 ①C1セルで管轄を絞り、該当以外を非表示にする　←一応できていること ②E1のキーワードで列を取得し、該当の列から空欄行を非表示にする　←できていないこと　例)「特別な周知」を選んだ場合、社長・専務・部長だけが表示されている状態にする ③抽出されたメールアドレスだけを、コピーした状態にする　←一応できていること「特別な周知」「一般周知」「依頼」により、メールを送る相手が異なるので、その条件にあった方だけを表示し、アドレスをコピーしたいという内容になります。リストが数百人に及ぶため、VBAで抽出できないかと考えております。 ①については、以下のコードで一応ソートはかけられてます。 Sub ソート() Rows.Hidden = False 　 Application.ScreenUpdating = False Dim Ws As Worksheet Set Ws = Worksheets("Sheet1") Dim Cmax As Long Cmax = Ws.Range("A65536").End(xlUp).Row Dim keyWord As String keyWord = Range("C1") Dim i As Long Dim Kankatsu As String For i = 4 To Cmax Kankatsu = Ws.Range("B" & i).Value If InStr(Kankatsu, keyWord) > 0 Then Else Rows(i).Hidden = True End If Next 　 Application.ScreenUpdating = True End Sub ②については、列の取得はできるもののそこから空欄を非表示にすることが出来ません。 Sub 指定した文字列の列を取得() Dim key As Long key = Rows(6).Find(Range("I2")).Column End Sub ③については、表示されているアドレスだけをコピーできてます。 Sub アドレスコピー() Dim endRow As Long endRow = Cells(Rows.Count, 4).End(xlUp).Row Range(Cells(4, 4), Cells(endRow, 4)).Copy MsgBox "アドレスをコピーしました。" End Sub 最終的に、①管轄でソート→②項目列を選択し空欄を非表示→③メールアドレスをコピーを[抽出]ボタン一つで出来るようにしたいと思っております。(画像3枚目) 何卒、よろしくお願いいたします。

質問日時: 2022/10/21 22:49 質問者: ひまわりとべんけい

ベストアンサー

3

0
VBAチェックボックスで有効無効切り替えできるように

現在は複数条件検索していますがもう一つ条件を足して（コマンドボックス5）検索をかけたいのですが何か良い方法ありませんでしょうか？例えばfoamのコマンドボックス５のところにチェック入れて有効になり外すと今まで通りの検索になるようにですね tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row) Dim i As Long ListBox1.Clear For i = 1 To UBound(tbl) If tbl(i, 2) = ComboBox3.Value And _ tbl(i, 3) = ComboBox4.Value And _ tbl(i, 7) = ComboBox5.Value And _'オプションボタンで無効有効化したい tbl(i, 10) = "" And _ tbl(i, 6) = ListBox2.List(ListBox2.ListIndex) * 1 Then tbl(i, 10) = "" '出荷日空白のみ With ListBox1 .AddItem tbl(i, 1) End With 宜しくお願い致します

質問日時: 2022/10/21 16:13 質問者: ka-.-ji

ベストアンサー

5

0
VBA ComboBoxについて

こちらのコードでコンボボックスにリスト一覧は表示させられるのですが選択したら1列目のみになってしまいますこちらとしては3列目のみ表示させたいですどのようにしたらよいでしょうか？ Private Sub UserForm_Initialize() Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("I" & Rows.Count).End(xlUp).Row End With With ComboBox6 .ColumnCount = 3 .ColumnWidths = "40;32;20" .RowSource = "Sheet2!I2:K" & lRow End With End Sub

質問日時: 2022/10/21 12:15 質問者: ka-.-ji

解決済

2

0
VBA For Each 〜複数条件について

EXCEL マクロ VBAについて質問をお願い致します。フォルダ内の全てのブックを開いて、 sheet名が「商品A」だったら処理①を行う sheet名が「商品B」だったら処理②を行うというコードについて下記で試したところ上手く行きませんでした。 For Each ws In Worksheets If ws.Name = "商品A" Then ws.Range(Cells(3 , 2),Cells(20 , 2)).Copy wb.Worksheets (mysht).Cells(lastrow , 3) ’処理① lastrow = lastrow + 18 End If If ws.Name = "商品B" Then ws.Range(Cells(3 , 2),Cells(20 , 2)).Copy wb.Worksheets (mysht).Cells(lastrow , 5) ’処理② lastrow = lastrow + 18 End If Next ws どなたかご教授頂けますでしょうか。宜しくお願い致します。

質問日時: 2022/10/20 20:05 質問者: おおむぎ

ベストアンサー

3

0
VBAコードで質問があります

ど素人で説明が難しいのですが Sheet１でセルE列（商品名）とセルJ列（販売形式）の組み合わせ（参照）で価格がセルｗ列に表示する方法ありますでしょうか？価格は別シートに記載してあるので計算入りません価格の組み合わせ記載場所は別シートの部類はI２（商品1）I4（商品2）I6（商品3）～I12（商品5）販売形式はJ2（通常）J3（お試し）J4（サンプルは商品すべてに適応）売値K2～12で金額を記載はしています出荷時に価格が表示してほしいので出荷のfoamでコマンドボタン押したらになります tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row) Dim i As Long ListBox1.Clear For i = 1 To UBound(tbl) If tbl(i, 2) = ComboBox3.Value And _ tbl(i, 3) = ComboBox4.Value And _ tbl(i, 10) = "" And _ tbl(i, 6) = ListBox2.List(ListBox2.ListIndex) * 1 Then tbl(i, 10) = "" '出荷日空白のみ With ListBox1 .AddItem tbl(i, 1) End With これを手を加えればできますかね？ AndのあたりをCellsかRangeで指定してリストボックスに表示ではなくセルに転記とか…(;^_^A安易ですかねどなたかご指導お願いいたしますm(__)m

質問日時: 2022/10/20 15:27 質問者: ka-.-ji

解決済

2

1
Sheet1のA列にコードB列にメアド、Sheet２のB列にコード一覧とD列にメアド一覧があり、Sh

Sheet1のA列にコードB列にメアド、Sheet２のB列にコード一覧とD列にメアド一覧があり、Sheet1のB2セルに=VLOOKUP(A2,Sheet2!B:D,3,FALSE)、B3セルに=VLOOKUP(A3,Sheet2!B:D,3,FALSE)と下にVLOOKUP関数が並び、Sheet2のメアド一覧を参照しています。VBA化で下記コードでエラー「WorksheetFunctionクラスのVlookupプロパティを取得できません。」となり、デバック「 Sht1.Cells(i, 2) = Application.WorksheetFunction. _ VLookup(Target, MyArea, 3, False)」で止まっています。初心者のため理解できないので解決策を教えていただけませんでしょうか。お願いします。 Sub Vlookup関数で値取得() Dim i As Long Dim Target As Variant Dim Sht1 As Worksheet Dim Sht2 As Worksheet Dim MyArea As Range 'シートを変数格納 Set Sht1 = Sheets("Sheet1") Set Sht2 = Sheets("Sheet2") '列を参照範囲に格納 Set MyArea = Sht2.Range("B:D") '2～600行目をループ For i = 2 To 600 '「名前」を取得 Target = Sht1.Cells(i, 1).Value Sht1.Cells(i, 2) = Application.WorksheetFunction. _ VLookup(Target, MyArea, 3, False) Next i End Sub

質問日時: 2022/10/19 11:57 質問者: momo_2123

ベストアンサー

3

0
フォーム上のリストボックスに重複して表示しています

現在、使用には問題ありませんがリストボックスに重複して表示されています数が多いので探すのが手間で少々気になりますできれば重複表示しないように出来ればと思いますコードはどのように変更または追加したらできますか？ Private Sub CommandButton3_Click() '検索ボタン Dim tbl As Variant Dim i As Long tbl = Range("D1:N" & Cells(Rows.Count, 4).End(xlUp).Row) ListBox1.Clear ListBox2.Clear For i = 1 To UBound(tbl) If tbl(i, 2) = ComboBox3.Value And _ tbl(i, 10) = "" And _ tbl(i, 3) = ComboBox4.Value Then With ListBox2 .AddItem tbl(i, 6) End With End If Next i End Sub

質問日時: 2022/10/19 11:55 質問者: ka-.-ji

ベストアンサー

3

0
VBAで質問があります

userfoamで出荷する際に販売価格の表示設定をしたいのですがどのように説明したらよいでしょうか？(;^_^A 在庫しているときはA~Kに情報が記載されていますおそらく出荷時に販売価格の設定をするのに必要な項目はE列（商品部類）とJ列（販売形式）の２つになります、その組み合わせで出荷時（W列）に価格表示させたいです価格の組み合わせ記載場所は別シートの部類はI２（商品1）I4（商品2）I6（商品3）～I12（商品5）販売形式はJ2（通常）J3（お試し）J4（サンプル）売値K2～12で金額を記載はしていますわかりづらいと思いますがコードお願い致します

質問日時: 2022/10/19 10:32 質問者: ka-.-ji

解決済

1

0
ExcelVBAで、index、match関数を使用して、指定範囲に出力したい

ExcelVBAで、index、match関数を使用して、 Cells(c, r) = .Index(myrng, .Match(key, Range("a2:a11"), 0), l)、Cells(c, r) = .Index(myrng, .Match(key, Range("a2:a11"), 0), l)c、r、ｌの2～3重ループで、同じ色の列で出力できるように、a2:f12→h2:m12、出力したのですが、上手くいきません。大変お手数ですが、どなたか、分かる方、教えて頂けないでしょうか？初心者なので、意味不明かもしれません。ご了承下さい。コード↓ Sub i_m3() Dim myrng As Range Dim c, r, k, l As Long Dim key As Variant Dim maxrow As Long Set myrng = Range(Cells(2, 1), Cells(11, 6)) maxrow = Cells(Rows.Count, 1).End(xlUp).Row For c = 2 To maxrow For r = 8 To 13 For k = 2 To 11 l = 1 '←for l= 1 to 6 にしたかったのですが、4重ループになり分からなくなりそうなので、forにしませんでした key = Cells(k, 1) With Application Cells(c, r) = .Index(myrng, .Match(key, Range("a2:a11"), 0), l) '←ここの部分です c = c + 1 If c = 12 Then Exit For End If End With Next Next Next ' Next End Sub

質問日時: 2022/10/18 21:53 質問者: zzhikkkk

ベストアンサー

3

1
エクセルのマクロとシートの保護について教えてください。

作業ブックに、先日教えて頂いた Sub メール提出() With Range("J40") If .Hyperlinks.Count > 0 Then .Hyperlinks.Item(1).Follow ElseIf .HasFormula And InStr(.Formula, "HYPERLINK") > 0 Then ActiveWorkbook.FollowHyperlink Address:=GetLinkURL(.Item(1)) Else MsgBox "ハイパーリンクは設定されていません" End If End With End Sub Function GetLinkURL(rTarget As Range) As String Dim v1 As Variant, v2 As Variant, str3 As String Dim i As Long If rTarget = "" Then Exit Function v1 = Split(rTarget.Formula, "HYPERLINK(") v2 = Split(v1(1), ",") For i = 0 To (UBound(v2) - 1) str3 = str3 & v2(i) & "," Next i str3 = Mid(str3, 1, Len(str3) - 1) With Cells(Rows.Count, 1).End(xlUp).Offset(1) .Formula = "=" & str3 '値取得はExcelにお任せ GetLinkURL = .Text .Clear End With End Function のマクロを設定しておりますが、この作業シートを保護設定した後に、マクロを実行すると「実行時エラー‘1004‘：アプリケーション定義またはオブジェクト定義のエラーです」と警告文が表示され「デバック」を参照すると「.Formula = "=" & str3 '値取得はExcelにお任せ」の部分が黄色なっております。シートを保護しても、マクロを実行できる方法を教えてください。よろしくお願いいたします。

質問日時: 2022/10/18 08:36 質問者: エクセル小僧

ベストアンサー

1

0
条件に一致した場合の処理

「メニュー」シートの家族名と「材料」シートの家族名が一致した場合、新たにシートを作成しA1には「メニュー」シートのA列の家族名を 2行目以降には「材料」シートのF～J列を整理番号の昇順で貼り付けシートの名前は「メニュー」シートのメニュー名にしたいです。メニュー名が他のシートと重複した場合、メニュー名に（1）（2）などをつけて区別させたいです。お詳しい方宜しくお願いいたします。

質問日時: 2022/10/18 06:30 質問者: さわ子

ベストアンサー

2

0
１つの入力フォルダの値を読み込み、3分割をして新しい変数に代入する方法を教えていただきたいです。読

１つの入力フォルダの値を読み込み、3分割をして新しい変数に代入する方法を教えていただきたいです。読み込むテキスト 1,2,1 1,2,1 1,2,1 1,2,1 1,2,1 1,2,1 1,2,1 1,2,1 1,2,1 このように入力されており、これを読み込んで3分割にし、３つの変数に分割したのを入れたいと考えております。コードはこのように書いています。 j = 0 Do Until ifs.AtEndofStream ¡Rec = ifs.ReadLine uArray = Split (iRec, “ ,”) Count = Count + 1 If Count < 3Then For k = 0 To UBound(uArray) uArray1(j, k) = uArray(k) Next j = j +1 ElseIf Count >2 And Count<6 For k = 0 To UBound(uArray) uArray2(j, k) = uArray(k) Next j = j +1 Endif Loop

質問日時: 2022/10/17 20:52 質問者: あろんこ

ベストアンサー

4

1
VBAでのMATCH関数

VBAにて価格を算出するマクロを作成しています。添付画像がイメージ図です。表①にて型式・材質によりコードを取得取得したコードに基づいて、MSHシートにある表②から価格を取得。何種類化のパーツがあるため、①で取得したコードは配列 PRICE()に格納して、 MATCHを使って、②の該当行を特定し、価格を間接的に導く方式にしています。 PRICEへの格納は別のモジュールで行っており、Variant/Doubleとして数値格納は成功しています。ただ実行してみると、最後の一つ（G_PRICE(2)の時）に実行時エラー１００４が出てしまいます。 VLOOKUPに変えてみたり、表の書式を「標準」「文字列」などに統一し直してみたりと試したのですが、エラーが止まることはありません。最後の一つ以外はうまく行っており、また参照している①・②は共通なので、コードや表自体がおかしい可能性は低そうなのですが、なにかエラーを生じさせている可能性があれば、ご教示いただけないでしょうか。【コード】 Sub 価格算出(ByRef P_PRICE() As Variant, ByRef G_PRICE() As Variant) Dim i As Long '処理用の変数 Dim ptr As Double, gtr As Double '該当パーツNoのある該当行 Dim end_r As Long: end_r = MSH.Cells(Rows.Count, "B").End(xlUp).Row 'マスターシートの最終行 Dim t_range As Range: Set t_range = MSH.Range("B3:B" & end_r) 'Noを探す範囲 For i = 0 To 2 ptr = WorksheetFunction.Match(Trim(P_PRICE(i)), t_range, 0) + 2 P_PRICE(i) = MSH.Cells(ptr, 10) gtr = WorksheetFunction.Match(Trim(G_PRICE(i)), t_range, 0) + 2 G_PRICE(i) = MSH.Cells(gtr, 10) Next End Sub

質問日時: 2022/10/17 19:06 質問者: tmtm_11

ベストアンサー

3

0
VBAでfunctionを利用しようとしたときに「引数は省略できません」というエラーが出ます

VBAでfunctionを利用しようとしたときに「引数は省略できません」というエラーが出て困っています。下記(長いので不要と思われる部分を省略した物)のようにtestの中でtoromajiという関数を呼び出して使用したいと考えているのですが str = toromaji(cni)のところで「引数は省略できません」というエラーが出るのですが、どの引数が足りなくてエラーが出るのか分かりません。解決方法、ご教示お願いいたします。 sub test() dim cni as long cni = 3 str = toromaji(cni) Debug.Print (str) end sub ------------------ Function toromaji(ByVal cni As Long) ThisWorkbook.Worksheets(1).Cells(cni, 3).Select Selection.Replace What:="あ", Replacement:="a" toromaji = ThisWorkbook.Worksheets(1).Cells(cni, 3).Value End Function

質問日時: 2022/10/15 16:30 質問者: sakura393938

ベストアンサー

1

0
ExcelからAccessのテーブルに書き込む時に時間がかかる

ExcelからAccessのテーブルに書き込みに以下のコードを使用しています。ネットにあったものを参考にさせていただいてます。データ数は5000ほどあります。現在職場で使用しているパソコン（cpuはi5でメモリは8G）では20秒ほどかかります。他のパソコンでも行おうとすると３分ほどかかります。ちなみに職場の同じ機種ではやはり20秒ほどで処理が終わります。別のメーカーのパソコン（スペックは同じかそれ以上）を何台か試しましたがすべて３分かかります。ファイルはネットワーク上にあるのですが、試しにCドライブ直下に置いても変わりませんでした。 Excelを他のパソコンに配布しなければならないのですが時間がかかりすぎるので使い物になりません。コードに問題があるのでしょうか？別の要因があるのでしょうか？とても困っています、どなたか教えてください。 Sub 在庫一覧書き込み() Dim adoCON As New ADODB.Connection Dim adoRS As New ADODB.Recordset Dim strSQL As String Dim odbdDB As Variant Dim wSheetName As Variant Dim i As Integer Dim wLastGyou As Long 'カレントディレクトリのデータベースパスを取得 odbdDB = ActiveWorkbook.Path & "\管理.accdb" 'データベースに接続する adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source=" & odbdDB & "" adoCON.Open 'トランザクション開始 adoCON.BeginTrans 'アクティブなシート名を取得 wSheetName = ActiveSheet.name With Worksheets(wSheetName) '最終行番号を取得 wLastGyou = .UsedRange.Rows.Count 'Excelの一覧を読み込みAccessに書き込む For i = 3 To wLastGyou 'IDの数値チェック（数字の場合は処理を実行） If IsNumeric(.Cells(i, 1).Value) And _ .Cells(i, 1).Value <> "" Then 'DB接続用SQL strSQL = "SELECT 在庫管理テーブル.* FROM 在庫管理テーブル " strSQL = strSQL & "WHERE ID = " & CLng(.Cells(i, 1).Value) & " ;" 'カーソルをクライアント側に設定 adoRS.CursorLocation = adUseClient 'レコードセットを開く adoRS.Open strSQL, adoCON, adOpenKeyset, adLockOptimistic '入力されたIDと同一のレコードが無い場合は新規登録 If adoRS.EOF Then adoRS.AddNew adoRS!ID = CLng(.Cells(i, 1).Value) End If adoRS!入庫日 = .Cells(i, 2).Value adoRS!担当 = .Cells(i, 3).Value adoRS!製番 = .Cells(i, 4).Value adoRS!注番 = .Cells(i, 5).Value adoRS!図番 = .Cells(i, 6).Value adoRS!品名 = .Cells(i, 7).Value adoRS!個数 = .Cells(i, 8).Value adoRS!保管1 = .Cells(i, 9).Value adoRS!保管2 = .Cells(i, 10).Value adoRS!出荷数 = .Cells(i, 11).Value adoRS!出荷日 = .Cells(i, 12).Value adoRS.Update 'レコードセットを閉じる adoRS.Close: Set adoRS = Nothing End If Next i End With 'トランザクション終了 adoCON.CommitTrans 'ADOコネクションオブジェクトのクローズ処理 adoCON.Close: Set adoCON = Nothing End Sub

質問日時: 2022/10/14 20:38 質問者: さわ子

ベストアンサー

1

1
ExcelVBA 日付変更

strDateにセル(10.7)の20180309を取得 strDateをstrDataに変換日付変更の実行実行していったのですが、なぜか19881230の日付で実行されてしまいます、ブック、シート、セルは指定してあるのですが、なぜこのようになってしまうのでしょうかデバッグしても正常に動きます。

質問日時: 2022/10/14 12:43 質問者: ぷりぷりん

解決済

3

1
VBAで出力したCSVファイルの先頭にカンマを挿入したい

エクセルから特定のシートをCSVで出力して、そのCSVをテキストで開いて先頭にカンマを１つ追加するというのを自動で行いたいです。（あるシステムで読み込ませるのに先頭文字がカンマでないといけないので）例： 1,1,0,東京都,ﾄｳｷｮｳﾄ ↑これを　↓このように ,1,1,0,東京都,ﾄｳｷｮｳﾄそもそもエクセルからCSV出力する際に、先頭にカンマを入れることができれば、わざわざその後にテキストで開いてカンマを追加するという作業もいらないのですが。。ちなみにVBAで特定のシートをCSVで保存するところまではできました。（A1を空白にしてCSV出力しましたが、先頭にカンマは入りません。）どなたかご教授願います。

質問日時: 2022/10/14 12:20 質問者: hisa99

ベストアンサー

5

1
ExcelVBA

特定のシートにメッセージボックスを表示させるにはどういった構文が必要でしょうか SHEET_MAIN_NAMEに Call MsgBox(a)を表示させたいです。

質問日時: 2022/10/14 10:35 質問者: ぷりぷりん

ベストアンサー

1

0
ファイル名の右側を変更したいファイル名：「1001日別売上」の左側へ「2022」を追加し、「202

ファイル名の右側を変更したいファイル名：「1001日別売上」の左側へ「2022」を追加し、「20221001日別売上」へ変更するのに下記コードを使っています。今回の質問としてファイル名：「20221001日別売上」の右側へ「_確認済」を追加し、「20221001日別売上_確認済」としたいのですが右側を変更するためのコード変更部分が解りません。よろしくお願いいたします。 Sub A2_指定文字追加() Dim FileP As String 'フォルダ選択のダイアログボックスを開く Application.FileDialog(msoFileDialogFolderPicker).Show '選択したフォルダのパス名を取得 FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) MsgBox "追加文字をコピーしてください" 'ファイル名の変換 Dim FileA As String '選んだフォルダの拡張子xlsを含むファイルを返す FileA = Dir(FileP & "\*.xls*") 'ファイル名の変換 Dim Str1 As String, Str2 As String '変換前の対象文字列 Str1 = InputBox("追加文字を貼り付けてください", "ファイル名変更", "") '←任意で変える部分 '変換後の文字列 Str2 = "" '←任意で変える部分 'フォルダ内のファイルがなくなるまで繰り返す Do While FileA <> "" '各ファイルのStr1部分をStr2に変換する Name (FileP & "\" & FileA) As (FileP & "\" & Str1 & FileA) 'Dirの指定をなくす FileA = Dir() Loop End Sub

質問日時: 2022/10/14 10:03 質問者: momo_2123

ベストアンサー

6

0
【再々投稿】VBAのプログラムで動作しなくて困っています

再々投稿になりますがうまく動作しない為困っています D列とE列に3桁、4桁の数字を入力した時にコロンを勝手に入力して時刻にするプログラムが常駐し、トグルボタンを押すことで ONの場合 B列に文字が入力された際にD列のみ現在の時刻を入力し E列に3桁、4桁の数字を入力した時にコロンを勝手に入力して時刻にするプログラムが動作し OFFの場合 B列に文字が入力された際にD列のみ現在の時刻を入力するプログラムがオフになり D列とE列に3桁、4桁の数字を入力した時にコロンを勝手に入力して時刻にするプログラムのみ動くプログラムですそれぞれソースコードを表記しますので解決をお願いします。 'トグルボタンのプログラム Private Sub ToggleButton1_Click() With ToggleButton1 If .Value Then 'トグルボタンONの処理 .Caption = "自動入力　ON" Range("J1") = "ON" MsgBox "自動入力が　ONになりました", vbInformation Else 'トグルボタンOFFの処理 .Caption = "自動入力　OFF" Range("J1") = "OFF" MsgBox "自動入力が　OFFになりました", vbInformation End If End With End Sub '3桁、4桁の数字を入力した時にコロンを勝手に入力して時刻にするプログラム Private Sub Worksheet_Change(ByVal Target As Range) Dim c, v Application.EnableEvents = False If Range("J1").Text = "ON" Then Set Target = Intersect(Target, Range("E:E")) If Not Target Is Nothing Then For Each c In Target.Cells v = c.Value If IsNumeric(v) And v > 0 And v Mod 100 < 60 Then c.Value = TimeSerial(Int(v / 100), v Mod 100, 0) c.NumberFormatLocal = "[h]:mm" End If Next c End If End If 'Call myTime_input(ActiveCell) Else Set Target = Intersect(Target, Range("D:E")) If Not Target Is Nothing Then For Each c In Target.Cells v = c.Value If IsNumeric(v) And v > 0 And v Mod 100 < 60 Then c.Value = TimeSerial(Int(v / 100), v Mod 100, 0) c.NumberFormatLocal = "[h]:mm" End If Next c End If End If Application.EnableEvents = True End Sub 'J1にONが入力されている時のみ,B列に値が入力されたらD列に現在の時刻を入力するプログラム Sub myTime_input(ByVal Target As Range) If Not Intersect(Target, Range("D:D")) Is Nothing Or Target.Count = 1 Then Call myTime_input(Target) If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, 2).Value = Time Application.EnableEvents = True End Sub

質問日時: 2022/10/14 09:06 質問者: shim0x

ベストアンサー

8

0
エクセルのマクロについて教えてください。

マクロ有効テンプレートに下記の2つのマクロを設定しております。 2つのマクロを連続して希望通りに実行できる方法を教えてください。マクロ-1 Sub 保存() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P2").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Worksheets("提出シート").Activate Range("B1", "C28").Select myBook = ThisWorkbook.Path Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Sheets("提出シート").Shapes("紙保存").Visible = False ' Sheets("提出シート").Shapes("注意").Visible = False ' ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P2").Value & "●.xlsx", FileFormat:=xlOpenXMLWorkbook Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With End Sub このマクロを実行すると不要なシートが削除され、指定セル値名で、マクロ有効ブック：xlsmと一般ブック：●.xlsx の2つのファイルで保存されます。マクロ-2 Sub メール提出() With Range("J40") If .Hyperlinks.Count > 0 Then .Hyperlinks.Item(1).Follow ElseIf .HasFormula And InStr(.Formula, "HYPERLINK") > 0 Then ActiveWorkbook.FollowHyperlink Address:=GetLinkURL(.Item(1)) Else MsgBox "ハイパーリンクは設定されていません" End If End With End Sub Function GetLinkURL(rTarget As Range) As String Dim v1 As Variant, v2 As Variant, str3 As String Dim i As Long If rTarget = "" Then Exit Function v1 = Split(rTarget.Formula, "HYPERLINK(") v2 = Split(v1(1), ",") For i = 0 To (UBound(v2) - 1) str3 = str3 & v2(i) & "," Next i str3 = Mid(str3, 1, Len(str3) - 1) With Cells(Rows.Count, 1).End(xlUp).Offset(1) .Formula = "=" & str3 '値取得はExcelにお任せ GetLinkURL = .Text .Clear End With End Function このマクロを実行すると指定セル値のハイパーリンクが開くようになってます。このマクロを連続して実行できるように Sub 提出統合() Application.Run "保存" Application.Run "メール提出" End Sub を作成して「Sub 提出統合()」を実行するとマクロ-1の「Sub 保存()」が上手く実行されるのですが、マクロ-2の「Sub メール提出()」が実行されません。原因として考えられるのが「Sub 保存()」が実行された後にすべてのファイルがクローズするので、「Sub 保存()」が実行されないのではないかと思います。「Sub 保存()」を実行後、マクロ有効ブック：xlsmはクローズされず、「Sub メール提出()」が実行ができ、その後、「Sub メール提出()」が実行後、マクロ有効ブック：xlsmと一般ブック：●.xlsxがクローズできる方法を教えてください。●.xlsxは「Sub メール提出()」の実行に関係が無いので、先にクローズしても構いません。今まで色々な方に教えて頂き、ここまで来ることができました、今回もご指導をよろしくお願いいたします。

質問日時: 2022/10/13 08:41 質問者: エクセル小僧

ベストアンサー

1

0
VBAのことで質問があります

Userformで入力を進めて最後にコマンドボタンでフォーム上に回数表示できますか？この動作を何回したかで個数の確認ができたらと思っています商品入荷での処理でfoam1を使っていますコマンドボックス1やコマンドボックス2を変更することによってカウントリセットコマンドボタン1で回数カウント、重複ウィンドウが出たらカウントしないが理想ですこんな説明ではわからないと思いますので回答していただいた方に詳細ご説明いたします。

質問日時: 2022/10/12 14:39 質問者: ka-.-ji

ベストアンサー

2

0
乱数の表示

いつもお世話になっております下記のコードは　セルに数字の乱数をひょうじされるのですが、一秒おきに変化させて10秒になったらおわりたいのですがわかる方おしえてくれませんでしょうか Sub randi() Dim i As Long, j As Long For i = 1 To 5 For j = 1 To 10 Randomize Cells(i, j).Value = Round(Rnd, 0) 'Rnd関数実行　引数なし Next j Next i End Sub

質問日時: 2022/10/12 10:43 質問者: りんごプリン

ベストアンサー

4

1
Excel VBA ファイル取得についてフォルダの中に、ファイル名“会議“を含むファイルが1つまた

Excel VBA ファイル取得についてフォルダの中に、ファイル名“会議“を含むファイルが1つまたは複数あります。《実行内容》 Dim fullPath As String, myFile As String ※fullPath 省略 myFile = Dir(fullPath & "¥" & "*会議*") “会議“ファイルが複数ある場合、ファイルを昇順に並べた時に一番上に来るファイル1つを取得したいです。どのようにしたら良いか教えて頂けると幸いです。宜しくお願い致します。

質問日時: 2022/10/12 01:18 質問者: m0m0-wan

ベストアンサー

9

0
エクセルのマクロについて教えてください。

Excelのマクロについて教えてください。マクロ Sub 保存() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P2").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Worksheets("提出シート").Activate Range("B1", "C28").Select myBook = ThisWorkbook.Path Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Sheets("提出シート").Shapes("紙保存").Visible = False ' Sheets("提出シート").Shapes("注意").Visible = False ' ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P2").Value & "●.xlsx", FileFormat:=xlOpenXMLWorkbook Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With End Sub があります。このマクロを実行すると不要なシートを削除指定セル値「P2」名でマクロ有効ブックと一般のExcelブックの2つのファイルが出来上がります。このマクロにハイパーリンク「=HYPERLINK("mailto:"&L33&"?cc="&L34&"&subject="&L35&"&body="&L36&"","メールを作成する")」を追加し、マクロが実行された最後にこのハイパーリンクを実行する方法を教えてください。よろしくお願いいたします。

質問日時: 2022/10/11 12:55 質問者: エクセル小僧

ベストアンサー

1

0
【再投稿】VBAで動作しなくて困っています

VBAのworksheet_changeで J1にONの値が入っているときのみ B列に文字が入力された場合 D列に時間を入力しそれ以外は D列とE列に 3桁か4桁の文字を入力した場合コロンを自動入力し時刻を入力するようにしましたが＞J1にONの値が入っているときのみ B列に文字が入力された場合 D列に時間を入力しの方だけうまく動かないので教えてくださいソースコード Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$J$1" If Range("J1").Value = "ON" Then If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, 2).Value = Time Application.EnableEvents = True Else End If End Select Dim myTime As Long If Intersect(Target, Range("D3:E1100")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target On Error GoTo EH If .Value <> "" Then If IsNumeric(.Value) And .Value > 0 Then If .Value - Int(.Value) = 0 And .Value Mod 100 < 60 Then myTime = .Value Application.EnableEvents = False .Value = TimeSerial(Int(myTime / 100), myTime Mod 100, 0) .NumberFormatLocal = "[h]:mm" Application.EnableEvents = True Exit Sub End If End If End If EH: Application.EnableEvents = False .ClearContents .Select Application.EnableEvents = True End With End Sub

質問日時: 2022/10/11 11:05 質問者: shim0x

ベストアンサー

2

0

【プログラミング・Web制作】に関するカテゴリ

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

質問する（無料）

【Visual Basic（VBA）】に関するコラム/記事

弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」

「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
釣りと密漁の違いは？知らなかったでは済まされない？事前にできることは？

知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
カスハラとクレームの違いは？カスハラの法的責任は？企業がとるべき対応は？

東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。この動きは自治体...
なぜ批判コメントをするの？その心理と向き合い方をカウンセラーにきいた！

今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...