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

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

回答数

気になる

セルに抜けた番号の代わりに空白を挿入する

A列のセルに番号が入力されています。セルの先頭行にある番号は必ず「1」です、最終行の番号は決まっていません。先頭行と最終行の間にはその範囲内の番号が昇順で入力されています。重複はありません。空白もありません。行の数は毎回違います。先頭行が「1」です、例えば最終行が「6」、その間のセルに「2」、「3」と入力してある時（A1が「1」、A2が「2」、A3が「3」、A4が「6」）抜けている番号に空白を挿入したいです。マクロを実行すると A1が「1」、A2が「2」、A3が「3」、A4が「空白」、A５が「空白」、A6が「6」としたいです。お詳しい方宜しくお願いいたします。

質問日時: 2023/04/10 20:29 質問者: さわ子

ベストアンサー

4

0
フォルダのサイズを一覧にしたかったのですが

フォルダのサイズを一覧にしたかったのですが、普通のフォルダではリスト化が可能ですが、Windowsのシステムフォルダだと、下記部分で、 FolderSizeMB = WorksheetFunction.RoundDown(eachFolder.Size / 1024 / 1024, 0) 書き込みできませんとエラーになります。原因はどこにあるのでしょうか

質問日時: 2023/04/10 20:12 質問者: ninin1234

ベストアンサー

1

0
EXCEL VBAで NHK NEWSの NEWSデータ内容取得ができない

EXCEL VBA で NHK NEWS、JAPANTIMES の URLからデータを取り出して整理しています。この数年間、問題なく NEWSデータ取得できていたのですが、新年度になって NHKの表示内容等の画面構成が変更されました。変更によってだと思われますが、NHK NEWS については、単純な画面表示もできなくなりました。下記のVBAで JAPANTIMESは問題なくとりこめていますが、NHKについては、空白のままです。どのように VBAを変更すれば表示されるようになるのか、教えていただけないでしょうか？よろしくお願いします。 ''' JAPANTIMES NEWS表示 Sub sample001JPT() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "https://www.japantimes.co.jp/news/" Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop End Sub ''' NHK NEWS表示 Sub sample001NHK() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "https://www3.nhk.or.jp/nhkworld/en/news/" Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop End Sub ' https://www.japantimes.co.jp/news/ ' https://www3.nhk.or.jp/nhkworld/en/news/

質問日時: 2023/04/09 12:26 質問者: せみやっち

解決済

1

1
VBA ユーザーフォームからSubプロージャ―に値を引き渡す方法

Subプロージャ―の変数にInputBoxなどから文字列を引き渡すことはよくあることだと思います。同じようなことをユーザーフォームで実現する方法を教えてください。 ※ユーザーフォームには選択肢がセットされたリストボックスとコマンドボタンがあります１、Subプロージャ―TESTを実行する２、ユーザーフォームが開く３、ユーザーフォームのリストボックスから値を選択４、ユーザーフォームのコマンドボタンクリックでSubプロージャ―内の変数strにリストボックスで選択された値を格納すると同時にユーザーフォームを閉じる５、Debug.Printでstrの値を確認するといったようなことをしたいです。

質問日時: 2023/04/09 01:54 質問者: tsukita

ベストアンサー

3

1
vba

お世話になります。エクセルシートの例えばセルＢ1からＢ4000まで文字（1-12，1-564等）が入力されていてその文字を検索値としてVLOOKUPしたいのですが、文字のなかに不要なものが入っているため検索できません。関数のTRIMを使えばできるのですが、VBAを使ってやってみたいと思っています。TRIMを使ってＢ1からＢ4000をA1からA4000に入力したいです。どなたかよろしくお願いします。

質問日時: 2023/04/07 12:33 質問者: とのつろ

ベストアンサー

15

0
エクセルVBAのコードで質問です。下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ

エクセルVBAのコードで質問です。下のコードはJ16の文字列をB3を起点とする範囲から探して、見つかったセルを赤く塗りつぶすものです。「Sub データ検索()」は本に載っていた一例です。私は自分で書こうとした場合難しく感じたので、もっと簡単にできないかなと考えたのが下の「Sub テスト()」です。実行すると、最後まで動作するのですが、実行されたままになっている感じで、Escを押さないといけません。何かが違っているのだと思っていますが、分かりません。どなたか教えて頂けないでしょうか。 Sub データ検索() Dim Myrange As Range Dim Hakken As Range Dim Banti As String Set Myrange = Range("B3").CurrentRegion Myrange.Offset(1).Interior.ColorIndex = xlNone Set Hakken = Myrange.Find(What:=Range("J16").Value, LookIn:=xlValues, _ LookAt:=xlPart, MatchByte:=False) If Not Hakken Is Nothing Then Banti = Hakken.Address Do Hakken.Interior.Color = vbMagenta Set Hakken = Myrange.FindNext(Hakken) Loop Until Hakken.Address = Banti End If Set Myrange = Nothing Set Hakken = Nothing End Sub ---------------------------------------------------------------- Sub テスト() Dim Myrange As Range Dim Hakken As Range Set Myrange = Range("B3").CurrentRegion Myrange.Offset(1).Interior.ColorIndex = xlNone Set Hakken = Myrange.Find(What:=Range("J16").Value, LookIn:=xlValues, _ LookAt:=xlPart, MatchByte:=False) If Not Hakken Is Nothing Then Do Hakken.Interior.Color = vbMagenta Set Hakken = Myrange.FindNext(Hakken) Loop Until Hakken Is Nothing End If Set Myrange = Nothing Set Hakken = Nothing End Sub

質問日時: 2023/04/07 11:07 質問者: wait4u

解決済

5

0
ChatGPTに作らせたい Excel VBA

ChatGPTでいろいろ試しているところです。 Excelで添付画像のような表（ナンプレですね）を用意します。ここからB2:J10の範囲だけのJpeg画像を出力させようと思います。ーーーーーーーーー EXCEL VBAで作成せよ。使用する変数は全て宣言する。 B2:J10をJPEG画像として出力。画像は縦横比ロックを解除。縦1000ピクセル、横1000ピクセルにフィットする大きさにする。ーーーーーーーーーみたいな指示から初めて、変数宣言が抜けてる、ココでエラー出てる、みたいな指示を重ねて試してますが、なかなか希望の動作になるものが生成できず。やろうとしていることはそんなに難しいことではないとは思うのですが、実際はもっと細かく指示をしてやらなければならないのでしょうか。 VBAマクロの完成形を求めてるのではなく『ChatGPTへの指示により完成させるなら、どういう指示が必要になるのか』という意味での質問となります。完成形を導き出せる指示の仕方がわかる方がおられましたら、よろしくおねがいします。

質問日時: 2023/04/05 19:56 質問者: zongai

解決済

1

0
置換について

いつもお世話になっております置換についておしえてくれませんでしょうかやりたいことは文字の中に東が入っていたら、東京東営業部文字の中に西が入っていたら、東京西営業部でなければ、東京営業部に変換したいのですが、わかる方おしえてくれませんでしょうかＣ列　　　　　Ｄ列東京東東京東営業部東京西東京西営業部東京　　東京営業部東京東Ａ東京東営業部東京西Ｂ東京西営業部東京Ａ東京営業部Ａ1東京東東京東営業部 2Ｂ東京西東京西営業部Ａ東京1 東京営業部

質問日時: 2023/04/02 11:54 質問者: りんごプリン

解決済

3

1
今日の日付が過ぎたらその行を削除したい

いつもお世話になっておりますＢ列に日付があり今日の日付が過ぎたらその行を削除したい下記のコードは作成したものの何回も実行しないときえないです。全部きえません。わかる方おしえてくれませんでしょうかＢ列の日付が　例）23年03月15日となっているため DateSerial(Year(.Cells(i, "B")), Month(.Cells(i, "B")), Day(.Cells(i, "Q"))) しています。間違えかもしれません。 Sub sdelete() Dim wS As Worksheet Dim i As Long For Each wS In Worksheets With wS For i = 5 To .Cells(.Rows.Count, "B").End(xlUp).Row If .Cells(i, "B").Value <> "" Then If IsDate(.Cells(i, "B").Value) = True Then If Date > DateSerial(Year(.Cells(i, "B")), Month(.Cells(i, "B")), Day(.Cells(i, "Q"))) Then .Range(.Cells(i, "B"), .Cells(i, "H")).Delete End If End If End If Next End With Next End Sub

質問日時: 2023/04/01 20:06 質問者: りんごプリン

解決済

1

0
エクセル VBA 処理スピードを上げたいのですが。

エクセルで、40000行のデータ（氏名や住所など40項目のデータ）を元データシートとし、コードをもとにコード名のシートに振り分け、振り分けが済んだら元データに色を付ける処理を行います。コードは、変動（毎月増える）がありますが、280件ほどで、シートも280シートをあらかじめ作っています。以下のコードで実行するのですが、オートフィルタを使っているためか、処理に30分ほどかかってしまいます。5分か、長くても10分で終わらせたいのですが、コードを編集することで劇的にスピードアップできたらうれしいのですが、どなたかど指南いただけないでしょうか。主なシート全コートが書かれているシート（1）元データがあるシート（1）それぞれのコードのシート（280） Sub コマンドボタンCMdata1_Click() Dim nums As Variant With UserForm1 .Show vbModeless .Repaint End With Application.ScreenUpdating = False Application.Calculation = xlCalculationManual nums = Array("001") Call CopyToTarget("001", nums) 　　　　　　|| 　　　　この間に、全コードがある　　　　　　||　 nums = Array("280") Call CopyToTarget("280", nums) Unload UserForm1 MsgBox "データをコピーしました。" Sheets("手順シート").Select 　Application.ScreenUpdating = True 　Application.Calculation = xlCalculationAutomatic End Sub Sub CopyToTarget(nameTargetSheet As String, numbers As Variant) Dim My_Target As Range Dim SelectedArea As Range Set My_Target = Worksheets(nameTargetSheet).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) With Worksheets("元データ") .AutoFilterMode = False .Range("A1").AutoFilter _ Field:=4, _ Criteria1:=numbers, _ Operator:=xlFilterValues .Sort.SortFields.Clear .Sort.SortFields.Add _ Key:=.Range("D2"), _ SortOn:=xlSortOnValues, _ Order:=xlAscending .Sort.SetRange .Range("A1").CurrentRegion .Sort.Header = xlYes .Sort.Apply Set SelectedArea = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible) SelectedArea.Copy My_Target My_Target.Resize(1, 66).Delete Shift:=xlUp SelectedArea.Interior.Color = RGB(255, 255, 0) .AutoFilterMode = False End With End Sub

質問日時: 2023/03/31 20:52 質問者: SC.ハーロック

解決済

6

0
転記するVBAコードを教えて下さい。

今記載しているVBAコードがあるのですが、うまく希望の転記ができません。そのエクセルデータを下記に添付させていただきます。このエクセルに、現在のVBAコード、やりたい事の条件、希望する転記後の状態、現在の処理の問題を記載しております。すみませんが、希望する転記後の状態にする為、現在のVBAコードをどの様に修正すれば良いか教えて下さい。すみませんが、よろしくお願いします。 https://1ne.jp/receiver/file_box.do?fb=9b9f506a46ef44e18fce09fdc18c848d&rc=467cbad6395145ecbe69c2126779d312&lang=ja

質問日時: 2023/03/31 17:22 質問者: qazwsx7410

解決済

1

0
VBA ステータスバー DoEvents

以下のコードを実行すると、途中でステータスバーが初期化?されて「準備完了」という表記に戻ってしまいます。最初のほうは正しく表示されます。 DoEventsがないと「応答なし」になるため、できればステータスバーが初期化?されない方法が知りたいです。 Sub test() Application.ScreenUpdating = False Dim i As Long For i = 1 To 100000 Application.Statusbar = "実行中..." (特定セル内容を別シートへ転記する処理) DoEvents Next i Application.Statusbar = False Application.ScreenUpdating = True End Sub

質問日時: 2023/03/30 12:22 質問者: ぶつりがくっておいしいの

解決済

1

0
パワポマクロVBAの準備で、リボンで（開発）を選択する方法

リボンから、開発を選択したいのに、選択肢に出てきません。環境設定から見ても、出てきません。どこから出せるのでしょう？（パワポ　音声データの編集を行います）

質問日時: 2023/03/29 01:32 質問者: タコ姫

ベストアンサー

2

0
列 A に同じ日が2つが必要です。

ChatGPT以下を質問しました。 -------------------------- エクセルで下記に示すように、列 A に同じ日が2つが必要です。その場合、オートフィルター機能が使えないので、手動で日付を入力しています。これをマクロで自動化するにはどうすればよいですか? 3月27日(月) 3月27日(月) 3月28日(火) 3月28日(火) 3月29日(水) 3月29日(水) 3月30日(木) 3月30日(木) 3月31日(金) 3月31日(金) 4月1日(土) 4月1日(土) 4月2日(日) 4月2日(日) 4月3日(月) 4月3日(月) 4月4日(火) 4月4日(火) 4月5日(水) 4月5日(水) 4月6日(木) 4月6日(木) 4月7日(金) 4月7日(金) 4月8日(土) 4月8日(土) 以前の混乱をお詫びします。列 A の各日付を複製する更新されたコードは次のとおりです。 vb Copy code Sub DuplicateDates() Dim lastRow As Long Dim i As Long lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 'get last row with data 'loop through each row and insert a duplicate date row below it For i = lastRow To 1 Step -1 Range("A" & i + 1).EntireRow.Insert 'insert new row below current row Range("A" & i + 1).Value = Range("A" & i).Value 'copy date value to new row Next i End Sub マクロを使用するには、Excel で Visual Basic Editor を開き、新しいモジュールを作成して、上記のコードを貼り付けます。次に、[実行] ボタンをクリックするか、キーボードショートカットに割り当てて、マクロを実行できます。何か問題が発生した場合に備えて、マクロを実行する前に必ずファイルを保存してください。以上ですがマクロは１０年ぐらい前に使った記憶しかないのです。 ChatGPTのマクロは入力しましたが、早速A列でオートフィルターに「同じ日がセルに２個づつ」列にでるかオートフィルタで試しましたが１個しかでてこなくて既存の機能しかできない状態です。　なぜですか？宜しくお願い致します。

質問日時: 2023/03/28 07:25 質問者: Campus_1986

ベストアンサー

1

1
ユーザーフォームのラベルに時間を表示させてずっと時間がちゃんと動くような方法はありますか？コード書い

ユーザーフォームのラベルに時間を表示させてずっと時間がちゃんと動くような方法はありますか？コード書いていただけると助かります。出来るだけ分かりやすくお願いします。

質問日時: 2023/03/28 03:48 質問者: kanatadatesama

解決済

2

0
検索のユーザーフォームの表示について

'検索フォームから渡された行番号のデータをセットする際、テキストボックスは下記マクロで表示できるのですがオプションボタンの９列目の「性別」が表示できません。画像のユーザーフォームは、シート2行目の山本彩を検索した結果ですが、シート2行目の性別は「女性」になっていますので、オプションボタンの「女性」がオンになった表示をすることはできますでしょうか。性別のオブジェクト名は「Frame7」になります。オブジェクト名で操作すれば表示できるのでしょうか？ご存じの方がいらっしゃいましたら教えてください。 Private Sub cmd検索_Click() '← 検索ボタン押下時の処理追加 frm検索.Show vbModal '← 検索フォームを表示する If rtnNo > 1 Then '検索フォームから渡された行番号のデータをセットする With Worksheets("master") Me.lbl行番号.Caption = rtnNo Me.txt_番号 = .Cells(rtnNo, 6) Me.txt_氏名 = .Cells(rtnNo, 7) Me.txt_ふりがな = .Cells(rtnNo, 8) If opt_男性.Value = True Then .Cells(rtnNo, 9).Value = opt_男性.Caption ElseIf opt_女性.Value = True Then .Cells(rtnNo, 9).Value = opt_女性.Caption ElseIf opt_性別その他.Value = True Then .Cells(rtnNo, 9).Value = opt_性別その他.Caption End If Me.txt_生年月日 = .Cells(rtnNo, 10) End With End If End Sub

質問日時: 2023/03/27 23:31 質問者: momo_2123

ベストアンサー

1

0
ユーザーフォームの表示を追加したい

検索のユーザーフォームでリストから氏名を選択する下記マクロを使っていますが、同姓同名がでてきたため、リストの表示にユニークな番号を追加したいのですができません。どのような変更をしたら良いか教えてください。 Private Sub SetListBox() '← リストボックスに表示する処理追加 Dim wRow As Long Dim wLstRow As Long Me.lst_リスト.Clear '← リストボックスを初期化 wLstRow = 0 For wRow = 2 To Worksheets("master").Range("F1").CurrentRegion.Rows.Count If Me.txt_氏名 = "" Then '検索する氏名が入力されていない場合は、 '「master」シートの2行目～最終行の行番号と顧客名をリストボックスにセット Me.lst_リスト.AddItem "" Me.lst_リスト.List(wLstRow, 0) = wRow Me.lst_リスト.List(wLstRow, 1) = Worksheets("master").Cells(wRow, 7) wLstRow = wLstRow + 1 Else If InStr(1, Worksheets("master").Cells(wRow, 7), Me.txt_氏名, vbTextCompare) > 0 Then '検索する対象者名が一部一致した場合、行番号と対象者名をリストボックスにセット Me.lst_リスト.AddItem "" Me.lst_リスト.List(wLstRow, 0) = wRow Me.lst_リスト.List(wLstRow, 1) = Worksheets("master").Cells(wRow, 9) wLstRow = wLstRow + 1 End If End If Next End Sub

質問日時: 2023/03/26 23:18 質問者: momo_2123

ベストアンサー

2

0
VBAでファイル名を指定して保存するとき

エクセルVBAでApplication.Dialogsを使用して保存した後、選択したフォルダを変数に持たせることは可能でしょうか。予めフォルダを選択するやり方も知っているのですが、ファイル名を固定で持たせ、かつ、パスワード設定なども一緒に設定したくて、Application.Dialogsを選択しました。次に保存するときに同じフォルダを参照先に持たせたいです。 Function FileSave(Extention As String, DialogNum As Integer) Dim FileName As String Dim Done As Variant FileName = "Test" & "_" & Format(Now(), "YYYYMMDDHHMMDDSS") IF Activesheet.Cells(1,1) = ”” Then SavePath = ThisWorkbook.Path Else SavePath = Activesheet.Cells(1,1) EndIF Done = IIf(Application.Dialogs(xlDialogSaveAs).Show(Arg1:=SavePath & "\" & FileName & Extention, Arg2:=DialogNum, Arg3:=Password), "保存", "キャンセル") 'ここに選択したフォルダのパスを入れたい Activesheet.Cells(1,1) = "直前で選択したフォルダのパス" End Function

質問日時: 2023/03/26 21:55 質問者: ゴードメリー

ベストアンサー

4

0
VBA シート上にドロップダウンリストを作り、予め指定値をセットしたいのですが

いつもお世話になります今、ValidateListを使ってシーt上にドロップダウンリストを作り、予め指定された値にしておきたいのですが、下記のようにテストプログラムを作ってみました Sub test() Cells(2, 10).Select: Call MakeDropDownList06(2): Selection.HorizontalAlignment = xlCenter End Sub Sub MakeDropDownList06(ByVal n As Integer) Dim moji As String Dim tmp As Variant moji = "SD345,SD390,SD490,SR235,SR295" With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=moji End With tmp = Split(moji, ",") With Selection .Value = tmp(n - 1) End With End Sub ここではSplitを使って、指定された番号の文字を挿入しているのですが UserFormでつかうComboBox1.LsitIndexみたいなものやもっとスマートな方法が有るのでないかと思い相談させていただきましたもし有れば、ご教授頂ければ幸いです以上、よろしくお願い申し上げます

質問日時: 2023/03/25 15:15 質問者: 公共ごま

ベストアンサー

1

0
２つ目のコンボボックスが動作しません。

同じユーザーフォーム２に２つコンボボックスがあります。１つ目のコンボボックスは動作します。(別ブックのシート) ２つ目が動きません。(同じブックの別シート)どうすれば動作しますか？助けてください。 Private Sub UserForm_Initialize()　　　　　　　　　　←１つ目のコンボボックス１ Dim wb As Workbook Dim sh As Worksheet Dim lastrow As Long Const TargetBook As String = "請求.xlsm" Dim myDesktop As String Dim wsh As Object Set wsh = CreateObject("Wscript.Shell") myDesktop = wsh.SpecialFolders("Desktop") Set wsh = Nothing 'ブック名:請求のフルパスを指定 Set wb = Workbooks.Open(myDesktop & "\" & TargetBook) Set sh = wb.Worksheets("請求先") lastrow = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row With ComboBox1 .List() = sh.Range("C2:C" & lastrow).Value .Style = fmStyleDropDownList End With wb.Close False '初期化処理 Worksheets("受注IMP").Activate End Sub Private Sub ComboBox1_Change() Worksheets("受注IMP").Range("B2").Value = ComboBox1.Text End Sub Private Sub コンボ2() 　　　　　　　　　　　　　　　　←　２つ目のコンボボックス２　　　　　 Dim lastrow As Integer　　　　　　　　　　　　　　　　　　　　　　　　　　　　 Dim i As Integer lastrow = Worksheets("荷主").Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow ComboBox1.AddItem Worksheets("荷主").Range("C" & i).Value Next i End Sub Private Sub ComboBox2_Change() Worksheets("受注IMP").Range("B3").Value = ComboBox2.Value End Sub

質問日時: 2023/03/25 12:29 質問者: BB_B

ベストアンサー

3

0
ユーザーフォームのラベルに時間を表示させてずっと時間がちゃんと動くような方法はありますか？コード書い

ユーザーフォームのラベルに時間を表示させてずっと時間がちゃんと動くような方法はありますか？コード書いていただけると助かります

質問日時: 2023/03/24 15:07 質問者: kanatadatesama

解決済

1

0
ユーザーフォームのラベルに日付を表示させる方法があればお願いします。出来ればコード書いていただけると

ユーザーフォームのラベルに日付を表示させる方法があればお願いします。出来ればコード書いていただけると助かります。

質問日時: 2023/03/24 15:06 質問者: kanatadatesama

解決済

1

0
PowerPoint VBA で画像の鮮明度を変更する方法がわかりません

日々パワーポイントで、スクリーンショットの画像を張り付けて、スライドを作成しています。その際、貼り付けた画像を選択し、『図の書式設定＞図の修正＞シャープネス＞鮮明度＋77％』なる操作を行います。操作完了までの手数が多いです。各スライド１or2画像なのですが、複数枚を毎日繰り返し操作します。マクロ実行の一動作で済むように簡単化したいです。 PowerPoint VBA の画像に関するサンプルを探しました。「画像に灰色の枠線をつける」ものまでは見出しましたが、“鮮明度”を変更・設定するものは見出せませんでした。 PowerPoint VBA で画像の鮮明度を変更するコードを教えてください。

質問日時: 2023/03/24 13:34 質問者: 重チャン

解決済

2

0
Excel VBA ユーザーフォーム１のコンボボックスに別ブックの値を反映させたいです。

ファイル名：受注票→ユーザーフォーム１にコンボボックス１があります。ファイル名：請求、シート名：請求先→コンボボックスに反映したいデータ元（C2からその下）があります。ブック名が別々な為、ファイル名：受注票のユーザーフォーム１にあるコンボボックス１に別ファイルの請求先データをもってくることができません。具体的にどう訂正すればいいのか教えて頂きたいです。よろしくお願いします。 *********************************************************** Private Sub ComboBox1_Change()　　　　←問題はこの部分です。 Dim wb As Workbook Dim sh As Worksheet Dim LastRow As Long With Workbooks.Open("C:\Users\XXXXXX\Desktop¥"請求先") '←ブック名:請求先のフルパスを指定 wb = Workbooks("請求") sh = Worksheets("請求先") LastRow = sh("請求先").Cells(Rows.Count, "C").End(xlUp).Row ComboBox1.RowSource = "請求先!C2:C" & LastRow End Sub ************************************************************* Private Sub CommandButton1_Click() '入力必須項目が未入力なら終了(登録しない) 'If TextBox1.Text = "" Then 'MsgBox "受注管理番号を入力してください。", vbInformation, "確認" 'Exit Sub 'End If Range("B4").Value = TextBox3.Value Range("B5").Value = TextBox4.Value Range("B6").Value = TextBox5.Value Range("B7").Value = TextBox6.Value Range("B8").Value = TextBox7.Value Range("B9").Value = TextBox8.Value Range("B10").Value = TextBox9.Value Range("B11").Value = TextBox10.Value Range("B12").Value = TextBox11.Value Range("B13").Value = TextBox12.Value Range("B14").Value = TextBox13.Value Range("B15").Value = TextBox14.Value Range("B16").Value = TextBox15.Value Range("B17").Value = TextBox16.Value Range("B18").Value = TextBox17.Value Range("B19").Value = TextBox18.Value Range("B20").Value = TextBox19.Value End Sub Private Sub CommandButton4_Click() Unload Me End Sub Private Sub UserForm_Initialize() '初期化処理 Worksheets("受注IMP").Activate End Sub

質問日時: 2023/03/21 16:12 質問者: BB_B

ベストアンサー

6

1
Excel VBA 複数選択したリストボックスからテキストボックスに転記したいです。

請求書を作る為のユーザーフォーム1を作っています。請求項目を入れるテキストボックスは20個あります。複数選択したリストボックスの値をテキストボックス１から6まで(20まで作るつもりです。)を上から順に転記したいです。毎回同じリストボックスの値を選ぶわけではありませんし、毎回6個のテキストボックスを使うわけでもありません。リストボックスの値を複数選ぶことはできたのですが、それ以降どのようにしたらいいのかわかりません。教えて頂きたいです。よろしくお願いします。順序は、１、リストボックスから複数選ぶ。２、CommandButton１を押す。３、テキストボックスに値が上から順に転記される。

質問日時: 2023/03/19 18:31 質問者: BB_B

ベストアンサー

3

0
数式が消える

Sub Print_Out_1() 'セルに値を設定しながら連続印刷する。印刷対象：アクティブシート Dim Message As Long Message = MsgBox("印刷してもいいですか？？", vbOKCancel, "メディカルＧ") If Message = vbOK Then Application.ScreenUpdating = False ActiveSheet.Unprotect Password:="0630" ActiveSheet.PageSetup.PrintArea = "B11:O30" '定数 Const conStart As Long = 1 '開始 Const conStep As Long = 1 '間隔 Const conCell As String = "K7" 'セル番地 '変数 Dim i As Long Dim conEnd As Integer '終了 With Application .ScreenUpdating = False conEnd = Val(.ActiveSheet.Range(conCell).Value) If conEnd >= 1 Then For i = conStart To conEnd Step conStep Range(conCell).Value = i '←追加コード ActiveSheet.PrintOut Next End If .ScreenUpdating = True End With Application.ScreenUpdating = True MsgBox "印刷が完了しました。" ActiveSheet.PageSetup.PrintArea = False ActiveSheet.Protect Password:="0630" End If End Sub のようなコードが書かれたExcelがあります。通常にXを押してExcelを閉じると何故か次に立ち上げて使用した時、数式が消えてしまいます。消えないようにしたいのですがわかりません。教えて頂けないでしょうか・・・

質問日時: 2023/03/19 16:55 質問者: tttaaa7

ベストアンサー

1

1
VBA 重複チェック後に値をワークシートに転記する方法を教えてください。

CommandButton１を押すとワークシートに値を転記するUserform１を作りました。やりたいことは、ワークシートに転記する前に登録済フリガナと、Userform１のTextBox1を比較し、重複していれば J列の重複チェックに"●”を入れ、ダイアログで重複していることを表示、処理を抜ける。重複していなければ新規登録できるようにしたいです。フリガナの小さい”ァ”や”ッ”等の拗音(捨て仮名)を大きな文字”ア””ツ”にした J列も必要かと思い作りました。本を参考にコードを書いていますが、どこをどのようにしたらいいのか分からず困っています。コードと一緒に説明文があると大変助かります。コードはこちらです。よろしくお願いいたします。ワークシート名：請求先 A列：No. B列：フリガナ(会社名を半角カタカナスペースなしで入力) ～ H列：重複チェック J列：拗音をExcelのSubstituteで大きくしたフリガナ -----------Userform１のコード-------------- Private Sub CommandButton1_Click() '入力必須項目が未入力なら終了(登録しない) If TextBox1.Text = "" Then MsgBox "半角カタカナスペースなしで入力してください。", vbInformation, "確認" Exit Sub End If '各テキストボックスの値をシートに転記 Dim TargetRow As Integer TargetRow = Range("A" & Rows.Count).End(xlUp).Offset(1).Row Range("A" & TargetRow).Value = TargetRow - 1 Range("B" & TargetRow).Value = TextBox1.Text Range("C" & TargetRow).Value = TextBox2.Text Range("D" & TargetRow).Value = TextBox3.Text Range("E" & TargetRow).Value = TextBox4.Text Range("F" & TargetRow).Value = TextBox5.Text 'リストボックスに追加 ListBox1.AddItem TargetRow - 1 ListBox1.List(ListBox1.ListCount - 1, 1) = TextBox1.Text ListBox1.List(ListBox1.ListCount - 1, 2) = TextBox2.Text ListBox1.List(ListBox1.ListCount - 1, 3) = TextBox3.Text ListBox1.List(ListBox1.ListCount - 1, 4) = TextBox4.Text ListBox1.List(ListBox1.ListCount - 1, 5) = TextBox5.Text 'コントロールのクリア TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub userform_Initialize() '初期化処理 Worksheets("請求先").Activate 'リストボックスの設定 With ListBox1 .Font.Size = 12 .ColumnCount = 6 .ColumnWidths = "1cm;6cm;8cm;2cm;11cm;2cm" .TextAlign = fmTextAlignLeft 'リストボックスに請求先情報を追加 Dim I As Integer Dim lastrow As Integer lastrow = Range("A" & Rows.Count).End(xlUp).Row For I = 2 To lastrow If Cells(I, 7).Value <> 1 Then .AddItem Cells(I, 1).Value .List(.ListCount - 1, 1) = Cells(I, 2).Value .List(.ListCount - 1, 2) = Cells(I, 3).Value .List(.ListCount - 1, 3) = Cells(I, 4).Value .List(.ListCount - 1, 4) = Cells(I, 5).Value .List(.ListCount - 1, 5) = Cells(I, 6).Value End If Next End With End Sub

質問日時: 2023/03/19 12:43 質問者: BB_B

解決済

1

0
【Excel VBA】条件に合った行の表示・非表示を行う方法

1か月の予定を入力する表を作りました。 1日から31日まで縦に並んでいて1日分31行ずつ使用しています。具体的には 6行目が1日でA6セルに「3/1」が入っています。 7行目から36行目までが予定入力行で、B列に1～30の連番が振られています。 37行目に「3/2」 38行目から67行目のB列に1～30の連番。以降、31日まで繰り返し。縦スクロールが必要な長い表になってしまうため、必要に応じてきゅっと縮めた表示をしたいです。以下の条件で表示させたい場合、全行に対して、.Rows.Hidden TRUE、FALSEで制御するよりも効率良い方法は無いでしょうか？日付と1～5まで表示(それ以外は非表示) 日付と1～10まで表示(それ以外は非表示) 日付と1～20まで表示(それ以外は非表示) 日付と1～30まで表示(つまり全部表示)

質問日時: 2023/03/18 12:31 質問者: tanapyondai

解決済

3

2
paintに貼り付けてある画像の大きさをvbaまたはそれに近いやり方で変更

いつも大変お世話になっております。 paintに貼り付けてある画像の高さと幅を変更すること（トリミング）は可能でしょうか具体的には、870×620px　→760×340px　に変更したいです。どうかよろしくお願いいたします

質問日時: 2023/03/18 09:16 質問者: 太郎です

ベストアンサー

1

0
ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。

ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。既にシート3行目の「田中博」の追加情報を別のユーザーフォーム「frm_旅行」で入力するため、検索リストから「田中博」を選択し、「frm_基本❷」に表示後、「旅行」ボタンをクリックし「frm_旅行」に表示させたいのですができません。新規行数の「４」となってしましまいます。何処を修正したら良いか教えてください。＜frm_基本のコード＞ Private Sub 旅行_Click() '← 検索ボタン押下時の処理追加 frm_旅行.Show vbModal '← 旅行フォームを表示する If rtnNo > 1 Then '検索フォームから渡された行番号のデータをセットする With Worksheets("master") Me.lbl行番号.Caption = rtnNo Me.txt_氏名 = .Cells(rtnNo, 3) End With End If End Sub Private Sub UserForm_Initialize() '← フォームを表示した時の処理追加 '行番号ラベルに最終行＋1をセット Me.lbl行番号.Caption = Worksheets("master").Range("B1").CurrentRegion.Rows.Count + 1 End Sub Private Sub cmd検索_Click() '← 検索ボタン押下時の処理追加 frm検索.Show vbModal '← フォームを表示する If rtnNo > 1 Then '検索フォームから渡された行番号のデータをセットする With Worksheets("master") Me.lbl行番号.Caption = rtnNo Me.txt_氏名 = .Cells(rtnNo, 3) Me.txt_住所 = .Cells(rtnNo, 4) Me.txt_電話番号 = .Cells(rtnNo, 5) End With End If End Sub Private Sub cmd_save_Click() '← 登録ボタン押下時の処理 Dim wRow As Long 'フォーム上の各データをシートへ送る With Worksheets("master") wRow = Me.lbl行番号.Caption .Cells(wRow, 9) = Me.txt_氏名 .Cells(wRow, 24) = Me.txt_住所 .Cells(wRow, 26) = Me.txt_電話番号 End With Unload Me End Sub Private Sub cmd_close_Click() Unload Me End Sub ＜frm_検索のコード＞ Private Sub UserForm_Initialize() '← フォームを表示した時の処理追加 rtnNo = 0 '← フォーム間のデータ受け渡し用変更の初期化 Call SetListBox '← リストボックスに表示する処理を実行(下部に処理記述) End Sub Private Sub txt_氏名_Change() '← 検索する氏名を入力した時の処理追加 Call SetListBox '← リストボックスに表示する処理を実行(下部に処理記述) End Sub Private Sub lst_リスト_DblClick(ByVal Cancel As MSForms.ReturnBoolean) rtnNo = Me.lst_リスト.Text 'リストボックスから氏名をダブルクリック選択した時の処理追加 Unload Me '← フォームを閉じる End Sub Private Sub SetListBox() '← リストボックスに表示する処理追加 Dim wRow As Long Dim wLstRow As Long Me.lst_リスト.Clear '← リストボックスを初期化 wLstRow = 0 For wRow = 2 To Worksheets("master").Range("B1").CurrentRegion.Rows.Count If Me.txt_氏名 = "" Then '検索する氏名が入力されていない場合は、 '「master」シートの2行目～最終行の行番号と顧客名をリストボックスにセット Me.lst_リスト.AddItem "" Me.lst_リスト.List(wLstRow, 0) = wRow Me.lst_リスト.List(wLstRow, 1) = Worksheets("master").Cells(wRow, 3) wLstRow = wLstRow + 1 Else If InStr(1, Worksheets("master").Cells(wRow, 3), Me.txt_氏名, vbTextCompare) > 0 Then '検索する対象者名が一部一致した場合、行番号と対象者名をリストボックスにセット Me.lst_リスト.AddItem "" Me.lst_リスト.List(wLstRow, 0) = wRow Me.lst_リスト.List(wLstRow, 1) = Worksheets("master").Cells(wRow, 3) wLstRow = wLstRow + 1 End If End If Next End Sub

質問日時: 2023/03/16 19:02 質問者: momo_2123

ベストアンサー

1

0
VBAで、1つのエクセルで、2つのシートからもう1つのシートに条件のある転記コードを教えてください。

【シート内の項目内容】・A.xlsmというエクセルに3つのシート（「A」「B」「まとめ」）があります。・「A」シートには、1列目＝手段、2列目＝行先、3列目＝車種、5列目＝受注NO、7列目＝受注数、9列目＝備考1、10列目＝備考2の項目にそれぞれのデータがあります。・「B」シートには、1列目＝車種、3列目＝製造NO、4列目＝在庫数、5列目＝製品単量、6列目＝備考3、7列目＝備考4、6列目＝備考5の項目にそれぞれのデータがあります。・「まとめ」シートには、1列目＝チェック、2列目＝手段、3列目＝行先、4列目＝車種、6列目＝受注NO、8列目＝受注数、10列目＝製造NO、11列目＝在庫数、12列目＝製品単量、14列目＝備考1、15列目＝備考2、16列目＝備考3、17列目＝備考4、18 列目＝備考5の項目があります。【やりたいこと】（1）「A」シートのデータあるだけ、「まとめシート」同じ項目同士の場所に転記します。（2）「B」シートの内容を「まとめシート」に転記した「A」シートのデータの横に、同じ項目同士の場所に製造NOのデータを転記します。 ≪（2）の転記条件≫ ①車種が一致。 ②車種の受注数を確認して、この数字以内の数字の製造NOを、「B」シートの上から順番に転記していく。転記は受注数を満たせば完了。同時にチェック項目のそれぞれの製造NO行に〇をつける。 ※受注数に対して在庫数を充てるのは受注NOの頭文字A＝国内は±10％まで、B＝海外は-10％までを条件に入れる ③それぞれの車種に、備考4（不良）、備考5（不具合）があれば、②の下に転記する ④それぞれの車種に、転記できていない車種の製造NOがあれば、最大さらに4つの製造NOのデータを③の下に転記する。同時にチェック項目のそれぞれの製造NO行に予備をつける。 ⑤車種が同じものがあった場合、必ず行先が国内か海外かで違う（見分け方は受注NOの頭文字A＝国内、B＝海外）のでこの場合、国内を優先して製造NOのデータを転記する。ややこしい内容ですが、どうか宜しくお願い致します。やりたいことの、before after の画像は下記のアドレスを参照ください https://gyazo.com/b03414810b3feb10a5a690b166883eb7

質問日時: 2023/03/16 18:07 質問者: qazwsx7410

ベストアンサー

1

0
EXCEL VBAにて動的にCheckBOXを複数作成し、同BOXにイベントを追加したい

シートモジュール内のPrivate Sub CommandButton1_Click()を実行すると 1.Sheet1シートのA列セル（今回はA1～A4までとします。)に複数Checkboxを動的に作成し、 2.同CheckBOXにChangeイベントを追加したい。　※追加するChangeイベントは　同CheckBoxがonになった際に　MegBox　にてCheckboxの名前を表示したい。のですが、web上のコードを参考に作成しましたが、CheckBoxの作成は出来たのですが、イベントの追加はクラスを作成し、同クラスとCheckBoxを紐づけるようですが、この辺りがあまり理解出来ていない様です。参考にしたweb上のコードは既にCheckBoxが存在していることを前提に記載されていましたのが、今回はクラスが作成された時点ではCheckBoxが存在しないのですから、何かしらのコードを追記しないといけないのでは？と考えますが、どの様にしたら良いか分かりません。どなたかご教示いただければ幸いです。以下コードです。 '＊＊＊＊＊＊＊＊＊＊＊＊＊ 'クラスモジュール　Class1 '＊＊＊＊＊＊＊＊＊＊＊＊＊ Dim WithEvents 作成 As MSForms.CheckBox Sub 紐付け(作成コントロール As MSForms.CheckBox) Set 作成 = 作成コントロール End Sub Private Sub 作成_Change() If 作成.value = True Then MsgBox 作成.Name Else: End If End Sub '＊＊＊＊＊＊＊＊＊＊＊＊＊ 'シートモジュール　Sheet1 '＊＊＊＊＊＊＊＊＊＊＊＊＊ Dim 動的作成() As New Class1 Private Sub CommandButton1_Click() Dim y As Integer For y = 1 To 4 'チェックボックス作成 Call createCheckBoxes(Cells(y, 1)) Next y 'チェックボックスとクラスを紐づけする　Call linkCheckBoxesEvent End Sub 'チェックボタン作成関数 Function createCheckBoxes(ByVal obj As Object) Dim StartX As Single 'セルの左端 Dim StartY As Single 'セルの上端 Dim EndX As Single 'セルの横幅 Dim EndY As Single 'セルの高さ Dim checkbox_cell As Object Set checkbox_cell = Cells(obj.Row, obj.Column) StartX = checkbox_cell.Left StartY = checkbox_cell.top EndX = checkbox_cell.Offset(0, 1).Left - checkbox_cell.Left EndY = checkbox_cell.Height 'チェックボックスオブジェクト作成 Dim checkbox_obj As OLEObject Set checkbox_obj = ActiveSheet.OLEObjects.Add( _ ClassType:="Forms.CheckBox.1", _ Link:=False, DisplayAsIcon:=False, _ Left:=StartX, top:=StartY, Width:=EndX, Height:=EndY) End Function 'チェックボックスとクラスの紐づけ Function linkCheckBoxesEvent() Dim 取得用 As Shape, インデックス As Long For Each 取得用 In ActiveSheet.Shapes If 取得用.Name Like "*CheckBox*" Then ReDim Preserve 動的作成(インデックス) 動的作成(インデックス).紐付け OLEObjects(取得用.Name).Object インデックス = インデックス + 1 Else: End If Next 取得用 End Function

質問日時: 2023/03/16 07:05 質問者: tanakappp

ベストアンサー

1

0
VBAを使いシート間で貼り付け

「シート1」のC・E・I・O列の値を図のような配置で「シート3」に値で貼り付けたいです。「シート1」のグループには空白がある場合があります。「シート3」にはすでに項目が埋まっている場合があります、仮に5番まで埋まっていたら次の6番に「シート1」の項目を追加していきたいです。「シート1」が未入力の場合、そのまま空白を「シート3」の空き項目に値で貼り付けたいです。「シート1」と同じフォーマットで入力済の「シート２」が存在した場合、同じマクロを実行したとき「シート3」の空き項目に貼り付けたいからです。グループに空白があるとどう貼り付ければ良いかわからなくなり、もう降参です。お詳しい方教えてください、宜しくお願いいたします。

質問日時: 2023/03/14 20:53 質問者: さわ子

ベストアンサー

3

0
Excel VBA オブジェクトマクロ使用指定についてお詳しい方教えてください。共通エクセルフ

Excel VBA 　オブジェクトマクロ　使用指定についてお詳しい方教えてください。共通エクセルファイルに４つのオブジェクトを挿入して個々に別のマクロを組み込んだのですが、そのオブジェクト毎に専用の人しか使用できないという条件指定をする事は可能なのでしょうか？ ※人物指定はUser Nameでいけそうな気がするのですが・・例オブジェクト1 Aさんのみ押せるオブジェクト2 Bさんのみ押せる間違え防止として表示などで注意喚起しても間違えてしまうらしく・・以上　アドバイスいただけたら助かります

質問日時: 2023/03/14 17:26 質問者: kazunoko1689

ベストアンサー

2

0
空白のセルを変更しようとした時(アクティブセル)にインプットボックスを5回出すインプットボックス

空白のセルを変更しようとした時(アクティブセル)にインプットボックスを5回出すインプットボックスには部品の名前を入力してもらい 1回目の入力だけはアクティブセルに表示し 1〜5回目は入力規則のリスト表示内に出力したいのですが Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim a As Variant Dim b As Variant Dim c As Variant Dim d As Variant Dim e As Variant Dim buf As Variant buf = a & "," & b & "," & c & "," & d & "," & e If Not Intersect (Target. Range("H3:H1000")) Is NothingThen If ActiveCell.Value = "" Then a = inputbox（"部品名を入カしてください”) For i = 1 To Windows .Count windows (i) .ActiveCell.Value = a Next i b = inputbox ("部品名を入力してください”) For i = 1 To Windows.Count Next i With ActiveCell.Validation .Delete .Add TypetexIValidateList. Formulal:=buf End With End If End If End Sub だとインプットボックスで入力してもリスト内容が空白になってしまい動作がうまく出来ず困っていますどなたか教えて頂けないでしょうかよろしくお願いします。説明が足らなかったら申し訳ありません

質問日時: 2023/03/14 11:01 質問者: MAXBETgoo

ベストアンサー

1

0
VBAでのループ順序について

たとえば、下記のVBAコードは在庫数を更新するコードなのですが、ループを回す際にどちらのシートからループさせれば効果的なのでしょうか？ ws1は、商品在庫全てのデータがあり行数は膨大で、 ws2は、その日の注文データが入っており行数は少ないです。私の考えでは、行数の少ないシートの2行目から値をまず取得し、行数の多いシートでマッチしたものを見つけて在庫処理、そしてその後また行数の少ないシートの3行目の値を取得、行数の多いシートへ、というほうが効率的に思えるのですが。。。処理は正常に行えており問題はないもののふと疑問に思いました。ちなみに今はやりのAIにこの疑問を問いかけたところ、行数の少ないほうからがよい、との回答を得たすぐあとに、やっぱり行数の多い方からがいいですよねえ、、、と念のために聞いたら、やはり行数の多い方からがよい、との回答で以降その繰り返しになりました。。。以上につきましてご助言いただけましたら幸いです。よろしくお願い申し上げます。以下、サンプルコード Set wb1 = Workbooks.Open("\\HogePC\hoge_data\在庫表.xlsm") Set ws1 = wb1.Sheets("総合") Set ws2 = wb1.Sheets("ABC商店") ' Find the last row in both worksheets lastRow1 = ws1.Cells(ws1.Rows.count, "U").End(xlUp).Row lastRow2 = ws2.Cells(ws2.Rows.count, "K").End(xlUp).Row ' Loop through each For i = 2 To lastRow2 For j = 2 To lastRow1 If ws2.Cells(i, "K").Value = ws1.Cells(j, "U").Value Then ' Check if K and M columns are not empty If ws2.Cells(i, "K").Value <> "" And ws2.Cells(i, "M").Value <> "" Then ws1.Cells(j, "AM").Value = ws1.Cells(j, "AM").Value - ws2.Cells(i, "M").Value ' Check if the stock became negative If ws1.Cells(j, "AM").Value < 0 Then minStockProductNum = ws1.Cells(j, "U").Value MsgBox "在庫がマイナスになっています！商品番号：" & minStockProductNum End If End If End If Next j Next i

質問日時: 2023/03/13 10:55 質問者: maru11586

ベストアンサー

3

0
Worksheet_Change

いつもお世話になっております下記の部分が黄色くなり、型が一致しませんとでます。 If .Value <> "" Then わかる方おしえてくれませんでしょうか Private Sub Worksheet_Change(ByVal Target As Range) Dim st As String With Target st = .Address(False, False) st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1)) Select Case st Case "B" If .Value <> "" Then With .Resize(, 7) .Borders.LineStyle = xlContinuous .Borders.ColorIndex = 6 .Borders(xlEdgeTop).ColorIndex = 6 End With Else .Resize(, 7).Clear End If End Select End With End Sub

質問日時: 2023/03/12 21:54 質問者: りんごプリン

ベストアンサー

4

1
Edge操作のアプリが例外発生に

VB.NET、Seleniumにより、Edgeを操作する自作アプリがあります。某サイトのリニューアルにより、例外が発生するようになりました。そのHTMLソース見ると、アプリでクリックしていた表示画面中のボタンの要素が存在しないのが原因のようです。そのボタンは、srcやhref中に存在するようになったのでしょうか？また、そのようになったボタンをクリックすることは可能なのでしょうか？可能であれば、その方法をご教示して頂きたくお願いします。

質問日時: 2023/03/12 21:22 質問者: isunsun

解決済

1

0
Excelのマクロについて教えてください。

マクロ Sub データコピペ() Dim expressionRng, destinationRng Dim n 'コピー元のファイルを開く Workbooks.Open ActiveWorkbook.Path & "\" & "FDﾃﾞｰﾀ.xlsx" Set expressionRng = Workbooks("FDﾃﾞｰﾀ.xlsx").Sheets("Sheet1").Range("A1:OZ12") Set destinationRng = ThisWorkbook.Sheets("FDデータ").Range("A1:B2") For n = 1 To expressionRng.Rows.Count destinationRng(n, 1).RowHeight = expressionRng(n, 1).RowHeight Next For n = 1 To expressionRng.Columns.Count destinationRng(1, n).ColumnWidth = expressionRng(1, n).ColumnWidth Next expressionRng.Copy destinationRng Workbooks("FDﾃﾞｰﾀ.xlsx").Close End Sub が有ります。このマクロはファイル名が「FDﾃﾞｰﾀ.xlsx」の指定セル値を作業ブックの指定シートの指定セル値にコピー＆ペースト出来ます。しかし、希にコピー元ファイルの「FDﾃﾞｰﾀ.xlsx」のセル値がペースト先のセルに上手くコピー＆ペーストが出来ない場合が有ります。コピー元からペースト先に確実にコピー＆ペーストが出来る方法があれば教えてください。もし、コピー範囲に問題が有る場合はコピー範囲は「A1:OZ12」となっておりますが、行は「１～12」までで列は「OZ」では無く、列の指定無しでも構いません。よろしくお願いいたします。

質問日時: 2023/03/12 12:16 質問者: エクセル小僧

ベストアンサー

1

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

マクロを実行して２つのファイルの内、マクロ有効「.xlsm」形式のファイルに指定シートを残し一般「.xlsx」にはシートを削除出来る方法を教えてください。マクロ Sub 電子提出() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Worksheets(Array("提出図書（参考）")).Delete Worksheets(Array("Web申請手順（参考）")).Delete Worksheets(Array("申請種別")).Delete Worksheets("提出シート").Activate Dim rng As Range Set rng = Selection.Cells Range("B1", "H47").Select myBook = ThisWorkbook.Path ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook rng.Select Worksheets(Array("消防の指摘一覧（参考資料）")).Delete Sheets("提出シート").Range("D3,D4,D7").ClearContents Range("D7").Select ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With Sheets("提出シート").Shapes("新築FD").Visible = False ' Sheets("提出シート").Shapes("計変FD").Visible = False ' Sheets("提出シート").Shapes("増築FD").Visible = False ' Sheets("提出シート").Shapes("担当者").Visible = False ' Range("D7").Select End Sub が有ります。マクロを実行すると不要シートを削除して、指定セル値をファイル名で、マクロ有効「.xlsm」と一般「.xlsx」の２つのファイルを作成出来ます。マクロを実行した時にシート名「消防の指摘一覧（参考資料）をマクロ有効「.xlsm」のファイルのみ残したいのですが、今のマクロコードだと逆の一般「.xlsx」にシートが残り、マクロ有効「.xlsm」のファイルではシートが削除されてしまします。シート名「消防の指摘一覧（参考資料）をマクロ有効「.xlsm」のファイルのみ残す方法を教えてください。よろしくお願いいたします。

質問日時: 2023/03/12 10:10 質問者: エクセル小僧

ベストアンサー

2

0
改ページ

いつもお世話になっております下記のコードは印刷範囲の設定のコードです添付ファイルのように　改ページの破線っていうのか黄色い部分を消すコードわかる方おしえてくれませんでしょうか印刷範囲はRange("B3").CurrentRegion.Addressで 20行おきに改ページを挿入したいのですが、わかりません。 ActiveSheet.ResetAllPageBreaksでもきえないのです。 With ActiveSheet .PageSetup.PrintTitleRows = "$3:$3" .PageSetup.PrintArea = Range("B3").CurrentRegion.Address End With

質問日時: 2023/03/10 21:29 質問者: りんごプリン

解決済

2

1
select caseの入れ子

いつもお世話になっております先ほど質問した内容とおなじなのでずが、ＩＦを使用しないでSELECT CASE の入れ子をためしまたが、　なにも結果が出ませんでした。どこがまちがえているのか、わかる方おしえてくれませんでしょうか Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim st As String Dim wf As Object Dim r As Range Dim a As Long, b As Long, c As Long Set wf = WorksheetFunction With Target st = .Address(False, False) st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1)) Select Case st Case "B" Case Is <= 1000 Range("G3").Value = wf.CountIf(r, "<=1000") Case Is <= 2000 Range("G4") = wf.CountIfs(r, ">1000", r, "<=2000") Case Is <= 3000 Range("G5") = wf.CountIfs(r, ">2000", r, "<=3000") End Select Set wf = Nothing End With End Sub

質問日時: 2023/03/08 18:48 質問者: りんごプリン

ベストアンサー

3

0
countifsについての質問

いつもお世話になっております下記のコードが動きません。Ｂ列に数字が入力されています。Ｆ列には添付ファイルのように 1000刻みで入力されています。個数を調べたいのですが、わかる方おしえてくれませんでしょうか Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim st As String Dim wf As Object Dim r As Range Dim a As Long, b As Long, c As Long Set wf = WorksheetFunction With Target st = .Address(False, False) st = Left(.Address(0, 0), IIf(.Address(0, 0) Like "[A-Z][A-Z]*", 2, 1)) Select Case st Case "B" For Each r In Range("B2", Cells(Rows.Count, 2).End(xlUp)) If r.Value <> "" Then a = wf.CountIfs(r, "<=1000") b = wf.CountIfs(r, ">1000", r, "<=2000") c = wf.CountIfs(r, ">2000", r, "<=3000") End If Next Range("G3").Value = a Range("G4").Value = b Range("G5").Value = c Set wf = Nothing End Select End With End Sub

質問日時: 2023/03/08 13:45 質問者: りんごプリン

ベストアンサー

3

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

マクロを実行した時にエラーが出て実行が出来ません、解決方法を教えてください。マクロ Sub 電子提出() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Worksheets(Array("提出図書（参考）")).Delete Worksheets(Array("消防の指摘一覧（参考資料）")).Delete Worksheets(Array("Web申請手順（参考）")).Delete Worksheets(Array("申請種別")).Delete Worksheets("提出シート").Activate Dim rng As Range Set rng = Selection.Cells Range("B1", "H47").Select myBook = ThisWorkbook.Path ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook rng.Select Sheets("提出シート").Range("D3,D4,D7").ClearContents Range("D7").Select ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With Sheets("提出シート").Shapes("新築FD").Visible = False ' Sheets("提出シート").Shapes("計変FD").Visible = False ' Sheets("提出シート").Shapes("増築FD").Visible = False ' Sheets("提出シート").Shapes("担当者").Visible = False ' Range("D7").Select End Sub があります。マクロを実行すると、作業フォルダ内に指定セル値をファイル名としてマクロ有効ブック方式と一般のExcel方式の2つのファイルで保存出来るようになっております。しかし、「ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled」の「Arg2」の部分が変色しマクロが実行できません。解決方法を教えてください。よろしくお願いいたします。

質問日時: 2023/03/08 09:08 質問者: エクセル小僧

ベストアンサー

2

0
EXCEL VBA 単語置き換えについて質問ですブック名ぶぶぶシート名しししセル V３〜

EXCEL　VBA 単語置き換えについて質問ですブック名　ぶぶぶシート名　しししセル　　V３〜V10　本当はV50000 ２行目は、見出しA、見出しB、と右方向へAB２セルまであります。セルの中身　最大300文字　　日本語文字英数字で、１セルあたり平均80文字入力既にある状態ざっくり言って　 V列の中に含まれる　特定の文字を指定する文字に置き換えます置き換え単語は同じブックの別のシートに用意されていますブック名　ぶぶぶシート名　おおお　　　列A　　　列B 行１　モモ　　　タコ行２　ハート　　ダイヤ行３　月曜　　　火曜行４この行は１０００行　同様にありますこの意味はブック名ぶぶぶ　にあるシート名ししし　の　列Vにある自由文章の中で単語モモのあるセルにはタコに置き換えるものです。置き換えた結果は列Vを上書きし、上書きを終えるとブック名ぶぶぶシート名ししし　この人の中身をそっくり複製してブック名　ニューシート名　新これでブック名ぶぶぶ　が保管された同じフォルダ内に新しいブックとして保存します行がたくさんありますし置き換えする単語も上から下に複数ありますし　わからなくなりました VBAのコードを教えてください

質問日時: 2023/03/08 01:41 質問者: pythons5

ベストアンサー

3

2
Excel VBA でデータ転記について

ファイル名をフォルダに作成するVBAを作りました。そのファイル名を①オプションボタン１～４を押したらファイル名の拡張子を除いてお尻に文字列”あ”を入れる。オプションボタン２を押す→い、３→う、４→えという風に。例）72030001（拡張子ナシ）あ。選択しない場合は選択を促す。ユーザーフォーム１,2,3,4のそれぞれのテキストボックス１にその値を転記する。②同じワークブックのシート１,2,3,4のそれぞれのB1セルにも同じ値を転記する。（ユーザーフォーム1＝ワークシート１）仕事に必要で尚且つ最近VBAを始めたばかりで、どうすればいいのか困ってしまい相談しました。どうぞよろしくお願いします。 Sub test() Const fpath As String = "C:\work\" Dim nen As Integer Dim wpath As String Dim fname As String Dim no As Integer nen = Year(Date) - Year(DateSerial(2023, 1, 1)) + 72 wpath = fpath & nen If Dir(wpath, vbDirectory) = "" Then MsgBox "今年のフィルダが作成されていません" Exit Sub End If fname = Dir(wpath & "\*.xlsx", vbNormal) Do Until fname = "" If Mid(fname, 5, 3) * 1 > no Then no = Mid(fname, 5, 3) * 1 End If fname = Dir() Loop fname = wpath & "\" & nen & Format(Month(Date), "00") & Format(no + 1, "000") ThisWorkbook.SaveAs fname & ".xlsm" End Sub

質問日時: 2023/03/07 19:11 質問者: BB_B

解決済

1

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

マクロを実行した時に保存先のダイナログを非表示で作業中のフォルダ内にダイレクトで保存出来る方法を教えてください。マクロ Sub 電子提出() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Worksheets(Array("提出図書（参考）")).Delete Worksheets(Array("消防の指摘一覧（参考資料）")).Delete Worksheets(Array("Web申請手順（参考）")).Delete Worksheets(Array("申請種別")).Delete Worksheets("提出シート").Activate Dim rng As Range Set rng = Selection.Cells Range("B1", "H47").Select myBook = ThisWorkbook.Path ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook rng.Select Sheets("提出シート").Range("D3,D4,D7").ClearContents Range("D7").Select Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With Sheets("提出シート").Shapes("新築FD").Visible = False ' Sheets("提出シート").Shapes("計変FD").Visible = False ' Sheets("提出シート").Shapes("増築FD").Visible = False ' Sheets("提出シート").Shapes("担当者").Visible = False ' Range("D7").Select End Sub があります。マクロを実行すると不要なシートを削除し、指定セル値をファイル名としてマクロ有効方式「.xlsm」と一般Excel方式「.xlsx」の2つのファイルで保存されますが、このマクロを実行した場合に、ダイナログが開き、保存先フォルダを指定して保存しておりますがダイナログを非表示で、ダイレクトで保存出来る方法を教えてください。よろしくお願いいたします。

質問日時: 2023/03/07 14:05 質問者: エクセル小僧

ベストアンサー

1

0
VisualBasic2015で変数の宣言の仕方を教えてください。さ

VisualBasic2015で変数の宣言の仕方を教えてください。さ

質問日時: 2023/03/07 09:55 質問者: あっきー126

ベストアンサー

3

0
Sheet2の日付をキーにオートフィルターで2023年1月のデータを抽出し、Sheet3へ書き出すた

Sheet2の日付をキーにオートフィルターで2023年1月のデータを抽出し、Sheet3へ書き出すため下記マクロを作りました。抽出条件をSheet1 のA2セルにあるプルダウンの「 2023/1/1」を活用しようと記述しましたがうまくいきません。実行するとSheet３には項目のNoと日付だけが転記されます。どのように変更したら良いか教えてください。 Sub データ抽出() Dim Sht1 As Worksheet Dim Sht2 As Worksheet Dim dt1 As String Dim dt2 As String Set Sht1 = Sheets("Sheet2") Set Sht2 = Sheets("Sheet1") dt1 = Sht2.Cells(2, 1).Value dt2 = DateSerial(Year(dt1), Month(dt1) + 1, 0) 'フィルターでデータ抽出 Sht1.Range("A1").CurrentRegion.AutoFilter _ Field:=2, _ Criteria1:=">=dt1", Criteria2:="<=dt2", Operator:=xlAnd Sht1 .Range("A1").CurrentRegion.Copy Sheets("Sheet3").Range("A1") End Sub

質問日時: 2023/03/06 23:57 質問者: momo_2123

ベストアンサー

2

0
VBAでセル同士を比較して色付け

D2以降とE2以降に数字が入力してあります。 D列に比べ（D3とE3、D7とE7、、）E列の値が小さい場合、E列のセルの値を赤くしたいです。これをA列を基準とした最終行まで行いたいです。お詳しい方宜しくお願い致します。

質問日時: 2023/03/06 19:57 質問者: さわ子

ベストアンサー

4

0

←前の結果
1
...
8
9
10
11
12
13
14
15
16
17
18
19
20
次の結果→

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

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

質問する（無料）

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

弁護士が解説！あなたの声を行政に届ける「パブリックコメント」制度のすべて

社会に対する意見や不満、疑問。それを発信する場所は、SNSやブログ、そしてニュースサイトのコメント欄など多岐にわたる。教えて!gooでも「ヤフコメ民について」というタイトルのトピックがあり、この投稿の通り、...
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」

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

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

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