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

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

回答数

気になる

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

マクロを実行した時に保存のダイナログが「非表示」の状態でダイレクトに保存できる方法を教えてください。マクロ Sub 行政報告2() Application.ScreenUpdating = False Dim folder As String folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\" & Worksheets("300").Range("A43").Text & "\" Dim initName As String initName = folder & Worksheets("1").Range("X1").Value newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm") If newName = False Then Exit Sub ThisWorkbook.SaveCopyAs newName Workbooks.Open newName Dim ws As Worksheet Dim TargetCheck As String Dim List As Variant Dim i As Long Dim Chk As Boolean List = Array("休日", "受付", "管理表") For Each ws In Worksheets Chk = False If ws.Visible = False Then For i = 0 To UBound(List) If ws.Name = List(i) Then Chk = True Exit For End If Next i If Chk = False Then TargetCheck = TargetCheck & ws.Name & vbCrLf Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If End If Next ws ActiveWorkbook.Close SaveChanges:=True Application.ScreenUpdating = True End Sub があります。マクロを実行すると指定の保存先フォルダが開き、指定のセル値がファイル名にて保存されますが、その都度、保存のダイナログが表示されます。このダイナログを非表示でそのまま指定フォルダ内に保存出来る方法を教えてください。よろしくお願いいたします。

質問日時: 2023/02/17 11:59 質問者: エクセル小僧

ベストアンサー

3

0
ExcelVBAに関する質問

以下コードのうち、 newWb.SaveAs Range("E3") & "\" & Format(Now, "yyyymmdd") & "_見込み有.xlsx" Dim folderPath As String folderPath = Range("E5") の箇所でエラー1004が発生します。該当のフォルダパスは以下の通りExcelに記載しており、フォルダも存在するのですが、解決策が分かる方はいらっしゃいますでしょうか？ ◆実行Excelシート E3セル C:\Users\kitto\Downloads\hokuho_フラグ有 E5セル C:\Users\kitto\Downloads\hokuo_履歴一覧 ◆コード Function GetKeywords() As String() Dim wb As Workbook Set wb = ThisWorkbook Dim ws As Worksheet Set ws = wb.Worksheets(1) Dim rng As Range Set rng = ws.Range("C3:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row) Dim keywords() As String ReDim keywords(1 To rng.Rows.Count) Dim i As Long For i = 1 To rng.Rows.Count keywords(i) = CStr(rng.Cells(i).Value) Next i GetKeywords = keywords End Function Sub TestGetKeywords() Dim keywords() As String keywords = GetKeywords() End Sub Sub SearchAndCopy() Dim wb As Workbook Dim newWb As Workbook Set newWb = Workbooks.Add Dim macroRunDate As String macroRunDate = Format(Now, "yyyymmdd") newWb.SaveAs Range("E3") & "\" & Format(Now, "yyyymmdd") & "_見込み有.xlsx" Dim folderPath As String folderPath = Range("E5") Dim file As String file = Dir(folderPath & "\*.xlsx") Dim keywords() As String keywords = GetKeywords() Dim copiedSheets As New Collection Do While file <> "" Set wb = Workbooks.Open(folderPath & "\" & file) Dim ws As Worksheet For Each ws In wb.Worksheets Dim rng As Range Set rng = ws.UsedRange For Each cell In rng Dim keyword As Variant For Each keyword In keywords If InStr(cell.Value, keyword) > 0 And Not SheetIsCopied(ws.Name, copiedSheets) Then ws.Copy After:=newWb.Sheets(newWb.Sheets.Count) copiedSheets.Add ws.Name Exit For End If Next keyword Next cell Next ws wb.Close file = Dir() Loop newWb.Close End Sub

質問日時: 2023/02/17 10:47 質問者: iwawawa

ベストアンサー

3

0
エクセルのマクロコードの一部分を変更する方法について教えてください。

コードの一部「folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\" & Worksheets("300").Range("A41").Text & "　【担当】確認番号　建物名称\"」があります。このコードはマクロを実行した時のファイルの保存先フォルダになります。このコードに指定シート名「300」指定セル「A43」（指定月）を追加する方法を教えてください。例えば今年の今月の保存先フォルダは「\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件（完了検査対象）\2023年　【担当】確認番号　建物名称\02月」になり上記フォルダの「\2023年」部分がコードの「 Worksheets("300").Range("A41") になります。コードの一部に月の部分「\02月」を指定シート名「300」指定セル「A43」と追加する方法を教えてください。よろしくお願いいたします。

質問日時: 2023/02/17 08:40 質問者: エクセル小僧

ベストアンサー

2

0
EXCEL VBAでA列にある空白行より下の行すべてを削除する方法を教えてください。

おはようございます。 A列からD列に、空白行が入ったデータがあります。空白行より下の行すべてを削除するVBAコードを教えてください。

質問日時: 2023/02/17 07:02 質問者: tommygoo1

ベストアンサー

3

1
VBS Bookを閉じるコード

いつも大変お世話になります。他のブックが開かれている場合は、自分のブックだけを閉じて他のブックが開かれていない場合は、Excelを終了するＶＢＳのコードをご教示ください。 Dim objExcel Dim xlSheet Set objExcel = CreateObject("Excel.Application") 'objExcel.Visible =true CreateObject("WScript.Shell").AppActivate objExcel.Caption objExcel.Workbooks.Open("\\●●●\disk\ファイル.xlsm") objExcel.Visible = False objExcel.Run "Module1.tws"

質問日時: 2023/02/16 17:31 質問者: 太郎です

ベストアンサー

1

0
VBAマクロ決まっていない行を選択して別シートへ貼付け

VBAマクロ超初心者です。添付画像のように作成をしたいのです。やりたいことは ①決まっていない複数行を自分で行選択し、別シート（Sheet2)切り取り貼付けしたい。（固定の行数ではないという意味です） ②Sheet1の大元ファイルで切り抜かれた空白行は削除して上に詰めたい。思考錯誤しましたが、まずSheet1の複数行を一度に選択し切り取ることはできないようですので 1行ずつ切り取りSheet2へ貼付けをする。その後、Sheet1の空白行をつめる考えたマクロ ① Sub GATTAI () Selection.Cut Sheets.Add After:=ActiveSheet ActiveSheet.Paste ② Sub kuuhakusakujyo Range("A1:A100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub ①で1個ずつマクロ作業を行うと、別シートに1個ずつデータが作られてしまう。添付画像のSheet2のように下にコピーされるようにしたい可能かどうかわかりませんが、①と②の操作を連続するマクロコードはどうなりますか？どなたかよろしくお願いします。

質問日時: 2023/02/16 16:08 質問者: mihomiho34

ベストアンサー

4

1
あるフォルダーのファイルを違う親フォルダーのサブフォルダーに移したい

タイトルに書きました通り、特定のフォルダーのファイルを違う親フォルダーのサブフォルダーに移動したいのですが、移動先がたくさんのフォルダーが階層になっていて上手く処理できません。ファイル名と一致するサブフォルダーに移動したいのですが、このファイル名も半角スペースがたくさん入っていて冗長になっています。自分で色々調べて書いてみたのですが、再起処理が上手くできません。どうかお力をお貸しいただけませんか？ Sub Test() Dim MyPath As String MyPath = "C:\Users\owner\Desktop\A\B\" Call Sample(MyPath) End Sub Sub Sample(MyPath As String) Dim F As Object Const folder1 As String = "C:\Users\owner\Desktop\テスト用\" Dim ファイル名, フォルダ名1, フォルダ名2, フォルダ名3 As String ファイル名 = Dir(folder1 & "*記録用*.xls") Do Until ファイル名 = "" フォルダ名1 = Split(ファイル名, " 記録用")(0) フォルダ名2 = Mid(フォルダ名1, InStr(フォルダ名1, " ") + 1) フォルダ名3 = Mid(フォルダ名2, InStr(フォルダ名2, " ") + 1) If Dir(MyPath & フォルダ名3, vbDirectory) <> "" Then Name folder1 & ファイル名 As MyPath & フォルダ名2 End If ファイル名 = Dir() Loop With CreateObject("Scripting.FileSystemObject") For Each F In .GetFolder(MyPath).SubFolders Call Sample(F.Path) Next F End With End Sub

質問日時: 2023/02/15 19:00 質問者: ももんがかわいい

ベストアンサー

11

1
Excel_マクロ_現在開いているシートにマクロを実行したいです

大変お世話になっております。以下ですと、Sheet3に対してしか実行出来ないマクロとなってしまいます…。シート名に関わらず、開いているシートに対してマクロを実行するコードに変更をお願い申し上げます。ご回答を、心よりお待ちしております。どうぞ宜しくお願い申し上げます。（Win11 Office365です） Sub Macro11() ' ' Macro11 Macro ' ' ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add2 Key:=Range("C2:C323" _ ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="〇,×", _ DataOption:=xlSortNormal ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add2 Key:=Range("G2:G323" _ ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Sheet3").Sort .SetRange Range("A1:FI323") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub

質問日時: 2023/02/14 23:54 質問者: yuri_7

ベストアンサー

1

0
EXCEL VBA データベースの内容をユーザーフォームに表示したい。

EXCEL　VBAについての質問です。データベースの内容をユーザーフォームに表示したいです。たとえばA1～A10セルの内容をテキストボックスやコンボボックス、リストボックスが含まれているユーザーフォームにループ等を使って表示させることは可能でしょうか。 TEXTBOX1 TEXTBOX2 TEXTBOX3 TEXTBOX4 COMBOBOX1 COMBOBOX2 TEXTBOX5 TEXTBOX6 TEXTBOX7 COMBOBOX3 後々追加があっても対応できるような方法を教えていただきたいです。

質問日時: 2023/02/14 11:40 質問者: jabcksjergt

解決済

5

0
Excel-VBAでのファイルの開き方

Excel-VBAでの基本的な質問です。ファイルをオープンする時の作法についてです。Office-TANAKAさんのページにあるサンプルソース、 http://officetanaka.net/excel/vba/file/file01.htm では、１）そのファイルがあるかどうかを確認する２）そのファイルが既に開かれているかどうかを確認する３）１）、２）とも問題がなければファイルを開くという段取りでエラーの出ないプログラムを書きましょうとなっております。で、実際にやってみたんですが、２）の処理を省いてもエラーは出ないことがわかりました。何故２）を省いてもエラーは出ないんでしょうか。これからも２）の処理を省いてVBAプログラムを書いていって問題はないんでしょうか。よろしくお願い申し上げます。（以下ソースコードです。） ---------------- Sub Sample7() Dim buf As String, wb As Workbook Const Target As String = "C:\Book1.xlsx" ''ファイルの存在チェック buf = Dir(Target) If buf = "" Then MsgBox Target & vbCrLf & "は存在しません", vbExclamation Exit Sub End If ''同名ブックのチェック。省いても問題ない？？？ ' For Each wb In Workbooks ' If wb.Name = buf Then ' MsgBox buf & vbCrLf & "はすでに開いています", vbExclamation ' Exit Sub ' End If ' Next wb ''ここでブックを開く Workbooks.Open Target End Sub ----------------

質問日時: 2023/02/14 11:01 質問者: hgama1024

ベストアンサー

4

0
VBA初心者です検索した数字の行に色をつける

はじめまして。 VBA初心者で、少しずつ勉強しています。行いたい動作は「検索窓に数字を打ち込み、A列にある指定の数字（完全一致）複数の行に色をつける」という動作なのですが、※「4.7.8」の行に色をつける指定の文字を検索する場合だと①のようになるとおもいますが ①Dim keywords As String keywords = InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること")　　　←指定された文字ではなく複数の数字を検索したい。 ⇓②はここまで自分で考えました ②With Range("A1", Cells(Rows.Count, 8).End(xlUp).Offset(, 1)).FormatConditions .Delete With .Add(xlExpression, Formula1:="=Find(""？？？"",$A1)")　←ココがわかりません。 .Interior.Color = RGB(221, 242, 214) End With End With End Sub （※Ａ列は必ず数字です） ①と②を組み合わせたい場合、どのようになりますでしょうか？説明がわかりずらくすみません。どなたかご指導願います。

質問日時: 2023/02/13 14:22 質問者: mihomiho34

ベストアンサー

5

0
エクセルVBAで以下のようなコードを書いたらエラーになりました。何処が間違っているの教えて？

コードは以下のとおりです。エラーメッセージは、「実行時エラー、-2147221005(800401f3), クラス文字列が無効です」。ブレークポイントでは６行目の「Set lbl=Me.Controls.Add("Forms.Labl.1", ,True)のところで、エラーになります。Addメソッドが間違っているのでしょうか？ご教授よろしくお願いします。 Dim lbl As MSForms.Label Dim i As Integer, j As Integer, c As Integer Dim Weekdays() As Variant 'データ型に注意 Weekdays() = Array("日", "月", "火", "水", "木", "金", "土") For i = 1 To 7 Set lbl = Me.Controls.Add("Forms.Labl.1", , True) With lbl .Caption = Weekdays(i - 1) .Width = 15 .Height = 15 .Left = 5 + (.Width + 2) * (i - 1) .Top = 20 .BorderColor = &H666666 .BorderStyle = fmBorderStyleSingle .Font.Size = 11 End With Next

質問日時: 2023/02/10 18:30 質問者: asahina316

ベストアンサー

1

0
Excel VBAの解読について質問があります。概要は、マクロでチェックボックスにチェックすると日

Excel VBAの解読について質問があります。概要は、マクロでチェックボックスにチェックすると日付が連動して自動表示されるようにしたいです。ただし、下記のVBAはA列にチェックボックスリンクセルがある時だけ反応します。これを、B列で反応するようにしたいですが、私には難しく解読できません。どうか、どなたかよろしくお願い致します。詳細な内容は下記のとおりです。 Sub Check() Dim ch As Shape Dim ad As String Application.ScreenUpdating = False ad = Selection.Address For Each ch In ActiveSheet.Shapes If ch.Name Like "Check Box*"Then ch.Select With Range("D"&Range(Selection.LinkedCell).Row) If Selection.Value = xlOn And .Value = ""Then .Value = Date ElseIf Selection.Value = xlOff And .Value <>""Then .Value = ""End If End With End If Next ch Range(ad).Select Application.ScreenUpdating = True Set ch = Nothing End Sub

質問日時: 2023/02/10 07:50 質問者: こごろーちゃん

解決済

1

1
visual basic初心者です。 visual studioで電卓を作成しています。実行時にテ

visual basic初心者です。 visual studioで電卓を作成しています。実行時にテキストボックスには初期値として「0.」を表示させ、数字ボタンやクリアボタンを押したときにテキストボックスの初期値「0.」は消えて数字が連続で入力されるようにしたいのですが、現時点では初期値「0.」(←テキストボックスプロパティのTextで設定)の後に数字ボタンを押すと「0.111」のように追記されてしまいます。また、小数点の計算もできるようにしたいです。何か解決法はないでしょうか？なるべく簡単な方法だと助かります。

質問日時: 2023/02/08 00:18 質問者: A3_hm

解決済

1

0
VBAコードを張り付け後のエクセルの進め方

Sub SumValues() Dim file1 As Workbook Dim file2 As Workbook Dim file3 As Workbook Set file1 = Workbooks.Open("file1.xlsx") Set file2 = Workbooks.Open("file2.xlsx") Set file3 = Workbooks.Open("file3.xlsx") file3.Sheets(1).Range("A2").Value = file1.Sheets(1).Range("A2").Value + file2.Sheets(1).Range("A2").Value file3.Sheets(1).Range("B2").Value = file1.Sheets(1).Range("B2").Value + file2.Sheets(1).Range("B2").Value file3.Sheets(1).Range("C2").Value = file1.Sheets(1).Range("C2").Value + file2.Sheets(1).Range("C2").Value file1.Close file2.Close file3.Close End Sub 上記コード内容でfile１Sheet１a2＝１０、ｂ２＝２０、ｃ２＝３０とfile２Sheet１a2=４０、ｂ２＝５０、ｃ２＝６０というファイルが二つあります。この二つのファイルのa2、ｂ２、ｃ２の値を合計した値をfile3のa2、b2、c2に合計値を表記するVBAコードを作成していただいたものです。 Excel のブックを開きます。 1.[Alt]+[F11] キーを押して VBA エディタを開きます。 2.左側の「Project Explorer」ウィンドウにある「Microsoft Excel Objects」を右クリックして、[Module] を選択します。 3.新しいモジュールが作成されたら、その中に上記の VBA コードをコピー＆ペーストします。 4.[Alt]+[Q] キーを押して VBA エディタを終了します。 5.各セルにデータを入力した後、マクロを実行するために、[Alt]+[F8] キーを押します。 6.Macros」ダイアログボックスから「SumCells」マクロを選択し、[Run] を選択します。 7.合計値が表示されたら、file3 シートに結果を保存します。上記　５．まで行えば簡単に行くのかと思ったのですが、全然だめでして、6.,7.の内容カ所が出てこないように思っており、そこがうまくいってないからなのでしょうか？どうか張り付けた後のエクセルの手続き順序を教えてください。コード自体にも問題があるのでしょうかコードはfile3に張り付けました VBAというフォルダーにfile1,file2,file3をまとめて入れております。このように一つのフォルダーにファイルを納めないといけないですか？ファイル形式はxlsm エクセルは３６５を使用しております。コードに関しては「ｃｈａｔＧＰＴ」よりの回答をそのままコピー貼り付けです。どうか基本がまったっくわかっていないので、ご迷惑かけますが何卒お教えください。お助けください。

質問日時: 2023/02/07 18:24 質問者: 7718toshi

ベストアンサー

2

0
エクセルマクロでアニメを作る方法を教えてください。

概要エクセルマクロでアニメを作る方法を教えてください。詳細エクセルでアニメを作りたいと思います。「エクセルでアニメ」とひとことで言ってもいろんなパターンがあると思います。画像描画機能で作成した、基本的な画像を上下左右に動かすもの、とかセルに文字列や記号を表示し、それを1セルずつ移動させてアニメーションさせるもの、とかセルに色塗りをしておおざっぱなドット絵を描いてそれを少しづつ変化させる、とか。今回は「予めペイント機能などで描いた画像をシート状に複写して用意しておき、それらを順に切り替えて表示しては消し、表示しては消し、を繰り返す、パラパラ漫画形式のアニメをつくる」とします。ここに既にペイント機能で作成した画像が数枚用意されているとします。画像の名称は "Picture 1"　"Picture 2"　"Picture 3"　（以下、必要な枚数ぶん、用意します）これらがシート１、　もしくはアクティブシートに存在しております。閲覧者に見えてしまってはよくないので、セルA1から遠く離れた位置に存在しているものとします。これを"Picture 1"をシートの左上（セルで言えばA1の位置）に移動させて、 1/24秒間表示し、元の位置に戻す次に"Picture 2"をシートの左上（セルで言えばA1の位置）に移動させて、 1/24秒間表示し、元の位置に戻す（以下、画像の数だけ繰り返す）というのをやりたいと思います。エクセルマクロに関して調べたら次のマクロでイケそうです。 Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) Sub macro1() Dim time As Long time = 42　'　time = 42　は、1/24秒間 '?1 Sleep time '?2 End Sub ？１のところに "Picture 1"をシートの左上（セルで言えばA1の位置）に移動させる ?2のところに元の位置に戻すのマクロプログラムを作って、あとは繰り返し行えばイケそうですどうやったら出来るでしょうか？教えてください。（なお、複写（コピペ）を使わずに移動を使うのは複写（コピペ）を使うと画像を指し示す"Picture 1"が変化してしまい、一回きりしかマクロが動かせなくなってしまうために割けるべきと考えました。他に良いアイディアがありましたらご教授願います）

質問日時: 2023/02/07 14:27 質問者: s_end

ベストアンサー

1

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 Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P1").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Worksheets("提出シート").Activate Range("B1", "H47").Select myBook = ThisWorkbook.Path ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P1").Value & "(提出用).xlsx", FileFormat:=xlOpenXMLWorkbook Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With End Sub があります、マクロを実行すると不要シートを削除して、ダイナログが開いて保存先のフォルダを選択して、指定セル値にてファイルを保存「マクロ有効ブック」「Excelブック」の両方保存出来出来ます。このマクロを保存先のダイナログが開かず、そのまま、マクロファイルがある同じフォルダ内に警告文等無しで「マクロ有効ブック」「Excelブック」の両方保存できる方法を教えてください。よろしくお願いいたします。

質問日時: 2023/02/07 09:58 質問者: エクセル小僧

ベストアンサー

2

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

マクロ Sub 作成() Dim filePath As String: filePath = ThisWorkbook.Path & "\FDﾃﾞｰﾀ.txt" Open filePath For Output As #1 Close #1 End Sub が有ります。マクロを実行するとテキストファイル名「FDﾃﾞｰﾀ.txt」が作成され、ファイルはクローズされます。このマクロを実行したタイミングで「FDﾃﾞｰﾀ.txt」が作成された後、作成されたテキストファイル「FDﾃﾞｰﾀ.txt」がそのまま開いた状態に出来る方法を教えてください。よろしくお願いします。

質問日時: 2023/02/05 09:55 質問者: エクセル小僧

ベストアンサー

4

1
swiftで年号を

Swiftで今日の年月日を表示するアプリを作ろうと汗かいています。が、年号の表示がうまくいきません。ChatGPTに尋ねたんですが、回答を実行しても実現しません。以下の回答をもらいましたが、これでもダメです。 let date = Date() let calendar = Calendar.current let year = calendar.component(.year, from: date) let era = year - 2018 + 1 Text("(era)年") //結果：(era)年……と年には変換にならず、そのままです。 ● ChatGPTに勝る解決策を教えてもらえませんか。ちなみにXcode 14.2です。

質問日時: 2023/02/05 06:48 質問者: danao_goo

ベストアンサー

1

0
if関数とifs関数は組み合わせることはできますか。セルA1が｢A｣のとき｢向日葵｣と表示。セル

if関数とifs関数は組み合わせることはできますか。セルA1が｢A｣のとき｢向日葵｣と表示。セルA1が｢B｣であるときはセルA2が 10以下の場合は｢松｣ 20以下の場合は｢竹｣ 30以下の場合は｢梅｣と表示し、上記の条件を満たさないときはセルA3が 10以下の場合は｢桜｣ 20以下の場合は｢桃｣ 30以下の場合は｢菊｣ 40以下の場合は｢楓｣ 50以下の場合は｢紅葉｣と表示。それ以外は｢該当なし｣と表示。 ↑ こちらをif関数とifs関数を使って値をかえすうにしたいのですがどのように設定するとよいでしょうか。

質問日時: 2023/02/02 20:48 質問者: tomorin_とも

ベストアンサー

4

0
ExcelのVBAコードについて教えてください。

VBAコードの一部を指定セル値にする方法を教えてください。 VBAコードの一部 If Target.Address <> "$C$20" Then Exit Sub If Target.Value <> "" Then If InStr(1, "一郎,次郎,三郎,四郎,五郎", Target.Value) > 0 Then On Error Resume Next Worksheets("受付").Visible = False Worksheets("管理表").Visible = False Worksheets("地方照会").Visible = False Worksheets("札幌道路").Visible = False があります。セル20に"一郎,次郎,三郎,四郎,五郎", のどれかの名前が表示されたタイミングで指定シート Worksheets("受付").Visible = False Worksheets("管理表").Visible = False Worksheets("地方照会").Visible = False Worksheets("札幌道路").Visible = False　等が非表示なりようになっております。 If InStr(1, "一郎,次郎,三郎,四郎,五郎", Target.Value) > 0 Then の各名前の部分"一郎,次郎,三郎,四郎,五郎"を指定セル値「AX101、AX102、AX103、AX104、AX105、AX106、AX107」の数値に変更する方法を教えてください。各セルAX101～107には「=TRIM('300'!B15)～=TRIM('300'!B21)」前の式があり各セルに名前が表示されます。よろしくお願いいたします。

質問日時: 2023/02/02 13:13 質問者: エクセル小僧

ベストアンサー

1

0
EXCEL VBA ユーザーフォームの内容をループでデータベースに登録したい。

EXCEL　VBAについての質問です。ユーザーフォームで複数の値をデータベースに登録したいです。たとえばTEXTBOX1～10の値をA1セルからA10セルに入れるにはループ処理で登録できることが分かるのですが、以下のようにテキストボックスやコンボボックス、リストボックスが含まれているときはループ処理できるのでしょうか。 TEXTBOX1 TEXTBOX2 TEXTBOX3 TEXTBOX4 COMBOBOX1 COMBOBOX2 TEXTBOX5 TEXTBOX6 TEXTBOX7 COMBOBOX3 現在はA1にTEXTBOX1、A2にTEXTBOX2と指定しているのですが、途中でユーザーフォームの項目を増やしたいとなった時にすべてずらさなければならないため、他に良い方法はないか。。。と思い質問させていただきました。ループでなくても構いませんので、後々追加があっても対応しやすい方法があれば教えていただきたいです。

質問日時: 2023/02/02 10:22 質問者: jabcksjergt

ベストアンサー

2

1
ExcelのVBAコードについて教えてください。

シート名「青紙表」にVBAコード Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$R$18" And IsNumeric(Cells(18, "R").Value) And Len(Cells(18, "R")) = 8 Then Application.EnableEvents = False Worksheets("青紙表").Range("AX3").Value = Worksheets("受付").Range("J2").Value Application.EnableEvents = True ActiveWorkbook.Save End If On Error Resume Next If Range("J53").Value = "■" Then Call 構造 End If If Range("CI27").Value = "■" Then Call 電子完了 End If If Target.Address <> "$C$20" Then Exit Sub If Target.Value <> "" Then If InStr(1, "一郎,次郎,三郎,四郎,五郎", Target.Value) > 0 Then On Error Resume Next Worksheets("受付").Visible = False Worksheets("管理表").Visible = False Worksheets("地方照会").Visible = False Worksheets("札幌道路").Visible = False Worksheets("札幌宅地").Visible = False Worksheets("札幌開発").Visible = False Worksheets("300").Visible = False Worksheets("500").Visible = False On Error Resume Next Application.DisplayAlerts = False Sheets("F審査").Delete Sheets("F設計INDX").Delete Application.DisplayAlerts = True End If Else On Error Resume Next Worksheets("受付").Visible = True Worksheets("管理表").Visible = True End If On Error Resume Next If Range("CI20").Value = "■" Then Call 日付 End If End Sub があります。各セル値によってVBAが実行されますが、 If Target.Address <> "$C$20" Then Exit Sub If Target.Value <> "" Then If InStr(1, "一郎,次郎,三郎,四郎,五郎", Target.Value) > 0 Then の部分をセルCE32に設定している数式「=IF( C20="", "□", "■" )」を利用して C20に各自の名前ではなく、C20に「■」表示されたときにコードが実行されるようにできる方法を教えてください。よろしくお願いいたします。

質問日時: 2023/02/02 09:25 質問者: エクセル小僧

ベストアンサー

1

0
VBAでWorkbook.addの使い方

VBA初心者です。入り口でつまずいています。 Workbook.addを使いたいのですが、１）関数main1の中で動かすとうまくいきます。２）関数main2から関数sub2を呼んでその中で動かそうとすると、関数コールの時点で、実行時エラー91（オブジェクト変数またはwithブロック変数が設定されていません）が起きます。２）は何故エラーになってしまうのでしょうか。以下ソースです。２）を改良して動かすにはどうしたらよいでしょうか。よろしくお願い申し上げます。 'Test Sub main1() Dim Wb As Workbook Set Wb = Workbooks.Add End Sub Sub main2() Dim Wb As Workbook sub2 (Wb) End Sub Sub sub2(Wb As Workbook) Set Wb = Workbooks.Add End Sub

質問日時: 2023/02/01 11:58 質問者: hgama1024

ベストアンサー

3

0
VBAで列を削除

月の集計の表を作っています。 31日分の列（複数列から構成）をテンプレートにしているため、各セルに日付を入れていくと、小の月の末に次の月の日付が入ってしまいます。次月の日付が表示される列自体が削除されるよう、以下のように書いてみました。当然でしょうが、エラーになりました。 F2セルにはシリアル値を入れました。ご教示お願いします。ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Sub deleteAfterEOM() '28のとき If Day(EoMonth(Range("F2"))) = Range("EK1") Then Range("EP1:FC41").EntireColumn.delete '29のとき ElseIf Day(EoMonth(Range("F2"))) = Range("EP1") Then Range("EU1:FC14").EntireColumn.delete '30のとき ElseIf Day(EoMonthRange(("F2"))) = Range("EU1") Then Range("EZ1:FC14").EntireColumn.delete End Sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

質問日時: 2023/02/01 11:00 質問者: danao_goo

ベストアンサー

3

0
vba マクロでファイル名をつけて保存するやり方を教えてください。マクロで作成したエクセルファイル

vba マクロでファイル名をつけて保存するやり方を教えてください。マクロで作成したエクセルファイル.xlsmを、.xlsxで名前をつけて保存したいです。毎日、毎回作るので、｢◯◯_2023.01.31｣とか、｢◯◯_2023.01.31_1523｣←15時23分みたいな感じで保存できればと思います。 _(._.)_

質問日時: 2023/01/31 18:22 質問者: tomorin_とも

ベストアンサー

2

0
エクセルVBAについて

エクセルVBAに詳しい方に質問です。もしA列の文字が入っていて、B列のセルが空白の場合メッセージボックスを表示させるそうでなければ、B列を基準に昇順に並び変えるというコードを組んでいただきたいです。ちなみに、B列が空白の場合、文字が入力できるメッセージボックスを表示させ、そこに入力した文字がセルに入力されるということは可能でしょうか？（B列の複数セルが空白の場合、順番に全ての空白に入力できるようにしたいです）よろしくお願いします。

質問日時: 2023/01/31 16:21 質問者: miffy0517

ベストアンサー

2

0
エクセル関数のことで質問です。別シートセルから値をもってくるように関数を設定しているときに、別シ

エクセル関数のことで質問です。別シートセルから値をもってくるように関数を設定しているときに、別シートの行を削除したりなどすると参照セルがないということで#REF となってしまいますが、行削除した後に置き換わった新たなデータを引っぱり、#REFとならないようにするにはどうすればよいでしょうか。（B2のセルにあったものが、B行を削除したことによって、C2セルにあったものがB2セルにきたとき、そのセルを引っぱってほしい）

質問日時: 2023/01/31 14:10 質問者: tomorin_とも

ベストアンサー

3

0
他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の

他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の「＊月」を参照しています。 Worksheets(1).Range("A3")が西暦だった場合、Fomatで月を取り出して下記マクロに組み込む方法を教えてください。 Sub test1() Dim Cop Set Cop = Worksheets(4).Range("G15:G18") 'コピー元 '処理月へ転記 Dim c As Long For c = 8 To 19 '４月～3月の範囲 If Cells(2, c).Value = Worksheets(1).Range("A3").Value Then Exit For Next c '該当月の指定 Worksheets(2).Cells(5, c).Resize(Cop.Rows.count, 1) = Cop.Value 'コピー先 End Sub

質問日時: 2023/01/30 18:48 質問者: momo_2123

ベストアンサー

8

0
vba エクセルマクロのことで教えてください。 A1 123 A2 234 A3 345 A4 45

vba エクセルマクロのことで教えてください。 A1 123 A2 234 A3 345 A4 456 A5 567 A6 000 A7 000 A8 000 A9 000 . . . A6セルより下の000となっている行をすべて削除したいです。 Bから右の列のセルにも値が入っていますがA列が000になっている行の情報は必要ないのですべて削除してしまって大丈夫です。そのときによってAの何行目以下が000になるかはまちまちです。プログラムを教えてください。よろしくお願いします。

質問日時: 2023/01/28 21:21 質問者: tomorin_とも

ベストアンサー

1

0
vbaで色付けされたセルを除外したいのですが

If aryWs2(cnt, 23) = d1 And Not aryWs2(cnt, 1) = (ColorIndex = xlNone) Or aryWs2(cnt, 14) = 1 And aryWs2(cnt, 11) < d2 Then でWs2の1列目の色付けされたセルを除外したいのですが色づけセルも選んでしまいます。色づけられたセルを除外する方法を教えてください。

質問日時: 2023/01/28 17:22 質問者: mossa_2007

ベストアンサー

5

0
vba 隣のセルに値がある行だけ関数をコピー&ペーストしたい A1 100001 A2 100002

vba 隣のセルに値がある行だけ関数をコピー&ペーストしたい A1 100001 A2 100002 A3 100003 A4 100004 A5 100005 A6 100006 A列に6桁の値があり、値があるセルだけ、隣のB列のセルにテキスト関数 =text（A1,¨0000000¨）を使って7桁表示させたいときのプログラムを教えてください。

質問日時: 2023/01/28 14:29 質問者: tomorin_とも

ベストアンサー

1

0
Excel VBAについて、フォルダ内のファイルを全て開きたい場合、 FSOを使えば、Dirは使わ

Excel VBAについて、フォルダ内のファイルを全て開きたい場合、 FSOを使えば、Dirは使わなくてもいいーという記事を見ました。下記コードについて Dirを使わずにどのようにしたらいいでしょうか？宜しくお願い致します。 'FileSystemObjectオブジェクト Dim fso As FileSystemObject Set fso = New FileSystemObject Dim A As String, B As String A = ThisWorkbook.Path & "\dta" B = Dir(A & "\*") Do While B <> "" Workbooks.Open Filename:=A & "\" & B B = Dir() Call シート非表示 Loop

質問日時: 2023/01/27 13:18 質問者: m0m0-wan

ベストアンサー

1

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

Excelのマクロについて教えてください。作業ブックをマクロ有効テンプレート形式「.xltm」で保存しております。マクロ Sub 担当者コピペ() 'コピー先のファイルを開く Workbooks.Open "\\nas-sp01\share\確認部\■意匠\戸建\戸建て電子申請関連\ひな形\【フラット】ひな形5-3（確認無物件）.xlsm" 'Book1の値をコピー Workbooks("【電子用】戸建て5-3（〇〇）.xltm").Sheets("300").Range("B15:C21").Copy 'Book2に値貼り付け Workbooks("【フラット】ひな形5-3（確認無物件）.xlsm").Sheets("F審査(紙)").Range("A57").PasteSpecial Paste:=xlPasteValues Sheets("F審査(紙)").Select Range("E15").Select Workbooks("【フラット】ひな形5-3（確認無物件）.xlsm").Sheets("F審査(Web)").Range("A57").PasteSpecial Paste:=xlPasteValues Sheets("F審査(Web)").Select Range("E15").Select Workbooks("【フラット】ひな形5-3（確認無物件）.xlsm").Save Workbooks("【フラット】ひな形5-3（確認無物件）.xlsm").Close End Sub を設定しております。ブックのファイル名は「【電子用】戸建て5-3（〇〇）.xltm」ですがマクロ有効テンプレートのブックを開くと「【電子用】戸建て5-3（〇〇）1.xltm"」となり（立ち上がりに：呼び込み専用とあります）このブック「【電子用】戸建て5-3（〇〇）1.xltm"」の状態で上記の「Sub 担当者コピペ()」を実行すると「Workbooks("【電子用】戸建て5-3（〇〇）.xltm").Sheets("300").Range("B15:C21").Copy」の部分が黄色くなりエラーがでてマクロが実行されません。「【電子用】戸建て5-3（〇〇）1.xltm"」を名前を付けて保存を選択しマクロ有効テンプレート形式の「【電子用】戸建て5-3（〇〇）.xltm」に上書き保存をしたのちに「Sub 担当者コピペ()」を実行すると上手くマクロが実行されます。解決方法がありましたら教えてください。よろしくお願いいたします。

質問日時: 2023/01/27 13:15 質問者: エクセル小僧

ベストアンサー

1

0
M365環境での動作エラー、及び対応相談

タイトルの通り、これまでAccess2016環境で動作できていたVBAがM365環境ではエラー発生により、動作できなくなりました。具体的には、以下構文になるのですがどのように修正すればよいかをアドバイスください。 Private Declare Function GetOpenFileName Lib "XXX.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long 当方の実施した処置としては、Declareの後にPtrsafeを挿入し実行してみたのですが、今度はファイルダイアログ自体が開かなくなった為、他の対応が必要なのではと考えています。現時点では、GetOpenFileの構文→FileDialogと、構文をより一般的なものへ変更するというのを一案として考えています。つきましては、以下アドバイスをください。（１）そもそも上記構文をM365環境で動作させるにはどのようにVBA修正すればよさそうでしょうか（２）修正案として、当方提案内容（GetOpenFileの構文→FileDialogへ変更）が妥当である場合、どのように構文変更するのがよさそうでしょうか。（１）のみ、（２）のみの回答でも構いません。何かしらアドバイスを頂けるとたすかります。よろしくお願いいたします。

質問日時: 2023/01/27 04:18 質問者: mame1216

ベストアンサー

1

0
【VBA】Excelの特定範囲のセルを画像で保存したい

Excel　VBAについての質問です。タイトルの通り、指定範囲（Range("A1:AJ58")）を画像で保存するマクロを作成したいです。保存先はブックと同じパスです。 Chart.Exportで画像通りのエラーが出てしまいます。 'Export'メソッドは失敗しました'Chart'オブジェクトどのように変更すればよいでしょうか。よろしくお願いいたします。 Sub PNG出力() Dim FileSize As Long Dim pic As ChartObject Dim picName As String: picName = ActiveWorkbook.Path & "\" & Range("C3") & ".png" Dim rng As Range: Set rng = Range("A1:AJ58") '■セル範囲を画像データでコピーする。 rng.CopyPicture '■指定したセル範囲と同じサイズのpicを新規作成し、保存する。 Set pic = ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height) pic.Chart.Export ThisWorkbook.Path & picName 'ここでエラー FileSize = FileLen(ThisWorkbook.Path & picName) '■picのFileSizeを超えるまでループする(画像データが出来上がったら終了する) Do Until FileLen(ThisWorkbook.Path & picName) > FileSize pic.Chart.Paste pic.Chart.Export ThisWorkbook.Path & picName DoEvents Loop '■作成完了後、pic削除。 pic.Delete Set pic = Nothing End Sub

質問日時: 2023/01/25 13:06 質問者: jabcksjergt

ベストアンサー

2

0
別シートから年齢別の件数をカウントしたいの続き

前回アップした画像のレイアウトで無事転記できました。みなさん　ありがとうございます。しかし画像のレイアウトは私のスキル不足を補うため、ご教示いただく内容を理解するため単純化しています。勉強のため実際のレイアウトにあてはめコードを書き換えてみたところ、やはり正常には転記できませんでした。エラーは出ないのですがカウントした値を目視で確認したところ、相違していました。単純化するため、マクロ実行前に省いていた抽出条件が2点あり、これが原因でしょうか。 _マクロ実行前に抽出した条件として①状況シートB列の月「12月」で抽出、②状況シートS列の条件１「あ」で抽出、この2点を手動で抽出後、下記マクロを実行しました。この条件で修正箇所がどこなのか教えていただけませんでしょうか。お願いいたします。 Public Sub 年齢別カウント_横() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim maxrow1 As Long 'B列最終行 Dim row1 As Long Dim row2 As Long Dim col2 As Long Dim rgs As String Dim rgs1 As String Dim rgs2 As String Dim idx As Long Dim bun As String Set sh1 = Worksheets("状況") Set sh2 = Worksheets("B表") sh2.Range("G15:M18").ClearContents 'B表の値をクリア maxrow1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row '状況B列最終行 For row1 = 3 To maxrow1 '状況3行目～最終行まで bun = sh1.Cells(row1, "U").Value '状況シートのC列分類１を選択 idx = GetBunrui(bun) '分類を取得 If idx < 0 Then MsgBox ("分類1不正") sh1.Select sh1.Cells(row1, "U").Select '状況の分類列U Exit Sub End If row2 = idx + 15 'B表分類1毎の行番号 idx = GetAge(sh1.Cells(row1, "K").Value) '状況の年齢列K col2 = idx + 8 'B表年齢毎の列番号 sh2.Cells(row2, col2).Value = sh2.Cells(row2, col2).Value + 1 Next For row2 = 15 To 25 'B表の分類C列の最初の行から最後の行　15To25 rgs = "H" & row2 & ":M" & row2 'B表の最初の年齢列H、最後の年齢列M sh2.Cells(row2, "G").Formula = "=sum(" & rgs & ")" 'B表の計列G Next MsgBox ("完了") End Sub Private Function GetBunrui(ByVal bun As String) As Long Dim buns As Variant Dim i As Long buns = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", " K") For i = 0 To UBound(buns) If bun = buns(i) Then GetBunrui = i Exit Function End If Next GetBunrui = -1 End Function Private Function GetAge(ByVal vage As Variant) As Long Dim vals As Variant Dim i As Long Dim age As Long vals = Array(15, 20, 25, 30, 35, 40) GetAge = UBound(vals) If IsNumeric(vage) = False Then Exit Function age = Int(vage) If age < vals(0) Or age >= vals(UBound(vals)) Then Exit Function For i = 0 To UBound(vals) - 1 If age >= vals(i) And age < vals(i + 1) Then GetAge = i Exit Function End If Next End Function

質問日時: 2023/01/24 00:16 質問者: momo_2123

ベストアンサー

5

0
VBAの繰り返し処理表記と複数の処置条件について

いつもお世話になっております。 https://oshiete.goo.ne.jp/qa/13311940.html の質問をした者です。この度、上記のVBAに繰り返し処理と【VAIO】の条件に加え【HP】も条件とする場合、どの様な構文になるのかのご教示をいただきたく質問させていただきました。 Sub Test() Dim rr As Range Dim rf As Range Set rr = Range("B3", Cells(Rows.Count, "B").End(xlUp)) Set rf = rr.Find("VAIO", , xlValues, xlWhole) If rf Is Nothing Then MsgBox "検索値は見つかりませんでした" Set rr = Nothing Exit Sub End If Range("C1:F1").Copy rf.Offset(, 6).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Set rr = Nothing Set rf = Nothing End Sub どうぞよろしくお願いいたします。

質問日時: 2023/01/23 20:08 質問者: pino382

ベストアンサー

1

0
ExcelのVBAコードについて教えてください。

VBAコード Private Sub Workbook_Open() Dim tmp, dNow tmp = Split(ThisWorkbook.Name, ".") If Split(ThisWorkbook.Name, ".")(UBound(tmp)) <> "xlsm" Then dNow = Format(Now, "yyyy/mm/dd") With Worksheets("300") If dNow >= Format(.Range("D39"), "yyyy/mm/dd") _ And dNow <= Format(.Range("E39"), "yyyy/mm/dd") Then MsgBox ("「締め切りが完了しました」"), 48 Call 比較日付 Call 便利帳比較 Call マクロひな形保存 Exit Sub End If End With End If End Sub があります。このコードは上記のセル値の日付の範囲以内でブックを開くと警告文が表示されてその後設定しているマクロが実行されます。現状では、警告文が表示されて「OK」をクリックしても、又、警告文の「×」をクリックしても設定しているマクロが実行されますが、警告文が表示されて「OK」をクリックしたときのみに設定マクロ実行され警告文の「×」をクリックした場合は設定しているマクロが実行されないようにする方法を教えてください。よろしくお願いいたします。

質問日時: 2023/01/23 17:13 質問者: エクセル小僧

ベストアンサー

2

0
別シートから年齢別の件数をカウントしたい

以前、年齢が縦に並んだ表へ別シートからデータをカウントしたマクロをご教授いただきました。今回、年齢が横に並んだ「B表シート」へ「状況シート」からカウントするため、下記マクロへ変更したのですが表が崩れてしまいできません。どのように修正したらよいか教えてください。 Public Sub 年齢別カウント_横() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim maxrow1 As Long '年齢最終行 Dim row1 As Long Dim row2 As Long Dim col2 As Long Dim rgs As String Dim rgs1 As String Dim rgs2 As String Dim idx As Long Dim bun As String Set sh1 = Worksheets("状況") Set sh2 = Worksheets("B表") sh2.Range("C5:G16").ClearContents '値をクリア maxrow1 = sh1.Cells(5, 8).End(xlToRight) '年齢最終列まで For row1 = 8 To maxrow1 '年齢列8行目～最終列まで bun = sh1.Cells(Rows.Count, "C").Value '状況シートのC列分類１を選択 idx = GetBunrui(bun) '分類を取得 If idx < 0 Then MsgBox ("分類1不正") sh1.Select sh1.Cells(row1, "C").Select Exit Sub End If col2 = idx + 3 '状況シート年齢列 idx = GetAge(sh1.Cells(row1, "E").Value) '年齢を取得 row2 = idx + 5 ' sh2.Cells(row2, col2).Value = sh2.Cells(row2, col2).Value + 1 Next For col2 = 3 To 6 rgs1 = sh2.Cells(5, col2).Address(False, False) rgs2 = sh2.Cells(15, col2).Address(False, False) rgs = rgs1 & ":" & rgs2 sh2.Cells(16, col2).Formula = "=sum(" & rgs & ")" Next For row2 = 5 To 16 rgs = "A" & row2 & ":F" & row2 sh2.Cells(row2, "G").Formula = "=sum(" & rgs & ")" Next MsgBox ("完了") End Sub Private Function GetBunrui(ByVal bun As String) As Long Dim buns As Variant Dim i As Long buns = Array("A", "B", "C", "D") For i = 0 To UBound(buns) If bun = buns(i) Then GetBunrui = i Exit Function End If Next GetBunrui = -1 End Function Private Function GetAge(ByVal vage As Variant) As Long Dim vals As Variant Dim i As Long Dim age As Long vals = Array(0, 20, 25, 30, 35, 40, 999) GetAge = UBound(vals) If IsNumeric(vage) = False Then Exit Function age = Int(vage) If age < vals(0) Or age >= vals(UBound(vals)) Then Exit Function For i = 0 To UBound(vals) - 1 If age >= vals(i) And age < vals(i + 1) Then GetAge = i Exit Function End If Next End Function

質問日時: 2023/01/23 12:00 質問者: momo_2123

ベストアンサー

6

0
ExcelのVBAコードについて教えてください。

先ほど教えて頂きました、コード Private Sub Workbook_Open() Dim tmp, dNow tmp = Split(ThisWorkbook.Name, ".") If Split(ThisWorkbook.Name, ".")(UBound(tmp)) <> "xlsm" Then dNow = Format(Now, "yyyy/mm/dd") With Worksheets("300") If dNow >= Format(.Range("D39"), "yyyy/mm/dd") _ And dNow <= Format(.Range("E39"), "yyyy/mm/dd") Then MsgBox ("「締め切りが完了しました」"), 48 Call 比較日付 Call 便利帳比較 Call マクロひな形保存 '上3行追加 '（必要に応じて記載モジュール名を付ける　例　call module1.比較日付） Exit Sub End If End With End If End Sub があります。このコードはセル値の範囲の日付に応じて警告文を表示させて警告文のOkを押したタイミングで指定マクロが実行できるコードです。マクロ：比較日付にてシート名受付のセルK10に日付が表示され、マクロ：マクロひな形保存にて作業ブックが保存されます。保存後再度、作業ブックを開いたときにシート受付のセルK10の日付が、上記設定のセルD39～E39の範囲内であれば保存後再度、作業ブックを開いたときに警告文が非表示できる方法を教えてください。よろしくお願いいたします。

質問日時: 2023/01/23 11:02 質問者: エクセル小僧

ベストアンサー

1

0
ExcelのVBAコードについて教えてください。

以前教えて頂きましたコード Private Sub Workbook_Open() Dim tmp, dNow tmp = Split(ThisWorkbook.Name, ".") If Split(ThisWorkbook.Name, ".")(UBound(tmp)) <> "xlsm" Then dNow = Format(Now, "yyyy/mm/dd") With Worksheets("300") If dNow >= Format(.Range("D39"), "yyyy/mm/dd") _ And dNow <= Format(.Range("E39"), "yyyy/mm/dd") Then MsgBox ("「締め切りが完了しました」"), 48 Exit Sub End If End With End If End Sub があります、このコードは指定セルの日付の範囲内によってブックをオープンした時に警告文が表示されます。この警告文が表示されたタイミングでマクロ比較日付便利帳比較マクロひな形保存上記の3つのマクロが実行できる方法を教えてください。よろしくお願いいたします。

質問日時: 2023/01/23 09:24 質問者: エクセル小僧

ベストアンサー

1

0
Activesheet.Pasteで困っています

ＷＥＢサイトから文字列を50行ほどコピーします。エクセルの1列目に張り付け、編集処理を行うマクロですが、 Columns(1).Clear Range("a1").Select ActiveSheet.Paste としたところ、Columns(1).Clearでコピーモードが解除されてPasteがエラーになってしまいます。行数は毎回変化するのでClearが必要です。対処方法があれば、教えてください。

質問日時: 2023/01/22 07:41 質問者: rexfan

ベストアンサー

1

0
VBAプログラム初心者です。以下の問題のプログラムを表記してみたのですが、実行するためには、どこを

VBAプログラム初心者です。以下の問題のプログラムを表記してみたのですが、実行するためには、どこを修正または補足すればよいでしょうか？ご教授お願いします。問題:半径1の円の面積はπです。Crude Monte Carlo法で半径1の円の面積を求めることで，円周率 π とその誤差を求めるプログラムを作成しなさい。

質問日時: 2023/01/19 20:04 質問者: wqmpmpw

解決済

4

0
vba Sleep関数について教えてください

いつもお世話になりますプログラムの実行中に現在の処理状況をUserformで下記ように Sleep関数を使ってUserに伝えていますが、時々メッセージを出したまま止まってしまいます原因が分からないので、もしご経験や問題点が有れば教えてくださいまた、他の良い方法をご教授頂ければ幸いです。 Private Sub UserForm_activate() Dim i As Long DoEvents Me.Label1.Caption = Message1 Sleep MilliTimer Unload Me End Sub 変数MilliTimerは、As LongでPublicにて定義されていますまた、Userformを呼び出す前にMilliTimer = 3000 と値をセットしています以上、よろしくお願い申し上げます

質問日時: 2023/01/18 10:18 質問者: 公共ごま

ベストアンサー

1

0
Excel VBA 同じ名前のフォルダがあれば作成したブックを格納するマクロをつくりたい

Excel VBAについての質問です。現在、建築関係の注文書を作成しています。作成した注文書をフォルダに自動的に格納されるマクロを作成することは可能でしょうか。注文書を作成するフォームでは既に登録した情報が2つのリスト形式で表示されるようになっています。（上からListbox1,Listbox2）それ以外の下3つの項目は作成時に入力します。登録ボタンを押すと、名前を付けてフォームの内容を反映した注文書を作成するようにしたのですがこれを工事場所の欄と同じ名前のフォルダに保存できるようにしたいです。フォルダに関しては注文書を格納するフォルダ（例では注文書作成フォルダ）を作成し、その中に保存していきたいです。 ①工事場所と同じ名前のフォルダが存在する場合 →作成した注文書を同じ名前のフォルダに格納 ②工事場所と同じ名前のフォルダが存在しない場合 →作成した注文書と同じ名前のフォルダを作成し、格納以上、よろしくお願いいたします。

質問日時: 2023/01/16 16:19 質問者: jabcksjergt

ベストアンサー

2

0
特定の文字を条件に指定範囲のデータを貼り付けるVBA

いつもお世話になっております。この度、下記の操作の自動化についてご教示をいただきたく質問させていただきました。自動化したい処理内容は下記の添付画像を例にご説明いたします。 B列3行目より下記には各機材名が入力されており、黄色で示しております【VAIO】の文字に一致した場合、C1～F1(※オレンジ色で示しましたA・B・C・D(※ここには関数が入力されています。)のセルのデータを、離れた位置にございます【VAIO】が入力されている行の、H5、I5、J5、K5セルに貼り付けたい処理の内容となります。どうぞよろしくお願いいたします。

質問日時: 2023/01/15 06:14 質問者: pino382

ベストアンサー

3

0
マクロを短くする

Sub Macro4() ' ' Macro4 Macro ' ' Range("D2:G2").Select Selection.Copy Range("AF2").Select ActiveSheet.Paste Range("I2:I5").Select Application.CutCopyMode = False Selection.Copy Range("AL2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("J2:J5").Select Application.CutCopyMode = False Selection.Copy Range("AQ2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("P2:P5").Select Application.CutCopyMode = False Selection.Copy Range("AV2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("K2:K5").Select Application.CutCopyMode = False Selection.Copy Range("BA2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("O2:O5").Select Application.CutCopyMode = False Selection.Copy Range("BF2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("Q2:Q5").Select Application.CutCopyMode = False Selection.Copy Range("BK2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("L2:L5").Select Application.CutCopyMode = False Selection.Copy Range("BP2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("N2:N5").Select Application.CutCopyMode = False Selection.Copy Range("BU2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("R2:R5").Select Application.CutCopyMode = False Selection.Copy Range("BZ2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("S2:S5").Select Application.CutCopyMode = False Selection.Copy Range("CE2").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("T2:AC2").Select Application.CutCopyMode = False Selection.Copy Range("CJ2").Select ActiveSheet.Paste End Sub このマクロをもっと短いマクロにひたいのですが、そのマクロを教えて下さい。宜しくお願い致します。後、３８５行まであります。できれば１行ずつのマクロの意味も書いて頂けると幸いです。

質問日時: 2023/01/15 00:11 質問者: ライザンバイア

ベストアンサー

1

0
VBAプログラミング

画像のような60人分の学生の平均点を計算するプログラムを作りたいのですが、Rnd関数とInt関数を用いた場合はどのよう表記されるのか教えてほしいです。宜しくお願い致します。

質問日時: 2023/01/14 00:38 質問者: wqmpmpw

解決済

4

0
前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ

前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループできないか下記コードで試したところエラーにはなりませんが、最上段のセルL3に「0」が入って終わってしまいました。全ての品名のカウントを変数cで指定したL列のぶどうDまで入力するにはどのようにしたらよいか教えてください。 Sub 抽出() '品名呼び出し Dim i For i = 3 To 22 Call 指定品名抽出(Worksheets("Sheet2").Cells(i, "B").Value) Next i End Sub Sub 指定品名抽出(ByVal hinmei As String) 　　　'オートフィルターで抽出　Dim Count As Long 　With Worksheets("Sheet3") '抽出条件1 Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues '抽出条件2 Range("B4").AutoFilter 6, hinmei 　Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1)) 　End With '処理月へ転記 Dim c As Long Dim d As Long With Worksheets("Sheet1") For c = 3 To 14 '４月～3月の範囲 For d = 3 To 22 If .Cells(2, c).Value = Worksheets("Sheet1").Range("A2").Value Then Worksheets("Sheet2").Cells(3, c) = Count - 1 Exit For End If Next d Next c '該当月の指定 End With Application.CutCopyMode = False End Sub

質問日時: 2023/01/13 22:01 質問者: momo_2123

ベストアンサー

7

0

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

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

質問する（無料）

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

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

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

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

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

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