回答数
気になる
-
【マクロ】値を渡されたプロシージャから実行すると、渡したプロシージャを選択される?
Q1 以下の【値を渡されたコード】から、実行すると、プロシージャ選択画面が出ます 当該画面を出さないようには出来ますか??? ちなみに、モジュールには当該2つのコードしか記述ありません 【値を渡されたコード】 Sub あいうえお(ByRef ws As Worksheet) ws.Cells(1, 1) = "あいうえお" ws.Cells(1, 2) = "かきくけこ" End Sub Q2【値を渡されたコード】から実行し、Sub 別ブックへ転記()プローシジャを選択すると Sub あいうえお(ByRef ws As Worksheet)のプローシジャだけではなく、Sub 別ブックへ転記()プローシジャ も実行されてしまいます。当該、動きは仕様でしょうか??? イメージは、Sub あいうえお(ByRef ws As Worksheet)だけ実行したので、他のプローシジャは 実行されないのではないかという、印象があります 【コード】 Sub 別ブックへ転記() Dim filpath1 As String Dim wb1 As Workbook Dim ws1 As Worksheet filepath1 = ThisWorkbook.Worksheets("Sheet1").Cells(141, 1) Set wb1 = Workbooks.Open(filepath1) Set ws1 = wb1.Worksheets("Sheet1") ws1.Cells(2, 1) = "xxx" Call あいうえお(ws1) End Sub ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ Sub あいうえお(ByRef ws As Worksheet) ws.Cells(1, 1) = "あいうえお" ws.Cells(1, 2) = "かきくけこ" End Sub
質問日時: 2025/02/23 12:18 質問者: aoyama-reiko
回答受付中
2
0
-
【マクロ】モジュール変数の記述時、Callにて、呼び出されたプロシージャから実行するとエラーとなる?
Q1標題の件、以下コード❶より実効すると、エラーとなります モジュール変数の場合は、呼び出し側から実行しないといけないルールですか??? 【Callステートメントにて呼び出されたコード❶】 Sub あいうえお() ws1.Cells(1, 1) = "あいうえお" End Sub Q2以下の共通コードを、1回だけしか書かないで、例えば5つのCallで呼び出す プロシージャで、共同利用する為には、値渡しが有効ですか??? 下記の例は、Callが1つしかありません。しかし、実際は5つ位を予定しています 【共通コード】 Dim filpath1 As String Dim wb1 As Workbook Dim ws1 As Worksheet filepath1 = ThisWorkbook.Worksheets("Sheet1").Cells(141, 1) Set wb1 = Workbooks.Open(filepath1) Set ws1 = wb1.Worksheets("Sheet1") 【コード】 Dim filpath1 As String Dim wb1 As Workbook Dim ws1 As Worksheet ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ Sub モジュール変数() filepath1 = ThisWorkbook.Worksheets("Sheet1").Cells(141, 1) Set wb1 = Workbooks.Open(filepath1) Set ws1 = wb1.Worksheets("Sheet1") Call あいうえお End Sub ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ Sub あいうえお() ws1.Cells(1, 1) = "あいうえお" End Sub
質問日時: 2025/02/23 11:57 質問者: aoyama-reiko
回答受付中
2
0
-
Vba Declare Functionを使う環境依存文字が化ける
いつもお世話になります DocuWorksの出力ファイルを操作する際、Declare Functionを使うのですが 環境依存文字を使ったファイルのハンドルを取るときなどに、ファイル名がFunctionの中で 化けているようでうまく行きません (宣言例) '2.64 XDW_OpenDocumentHandle DocuWorksファイルにアクセスするためのハンドルを得る。この場合だけ、pHandleはByRefで定義 Public Declare PtrSafe Function XDW_OpenDocumentHandle Lib "xdwapi.dll" (ByVal lpszFilePath As String, ByRef pHandle As LongPtr, ByRef pMode As XDW_OPEN_MODE) As LongPtr Public Type XDW_OPEN_MODE nSize As Long nOption As Long End Type '2.6 XDW_CloseDocumentHandle DocuWorksファイルにアクセスするためのハンドルを解放する。 Public Declare PtrSafe Function XDW_CloseDocumentHandle Lib "xdwapi.dll" (ByVal handle As LongPtr, ByVal reserved As String) As LongPtr (使用例) '...DocuWorksファイルにアクセスするためのハンドルを得る。 XDW_OpenDocumentHandle FileInfo(1), lngHandle, myMode '...FileInfo(1)のファイル、最終ページにFileInfo(2)以降の図面を挿入する。 XDW_InsertDocument lngHandle, myInfo.nPages + 1, FileInfo(k), vbNullString ファイル名は変数、FileInfo(k)になります 今は、環境依存文字を見つけて一度、変換して処理して終了後に元戻す方法を考えています これは、あきらめてファイル名を変更するしかないですか? 何か参考になることが有りましたら教えてください 以上、宜しくお願い申し上げます
質問日時: 2025/02/22 15:15 質問者: 公共ごま
回答受付中
2
1
-
Excelのマクロについて教えてください。
マクロを実行するとOutlookメールを送信できます。 コードはマクロの一部のコードです。 Toをセル値「V1」 CCををセル値「X1」 BCCををセル値「Z1」 に設定したメールアドレスでメールを送信できるようにしております。 この設定のCCとBCCを複数設定する方法を教えてください。 CCををセル値「X1」「X2」「X3」 BCCををセル値「Z1」から「Z12」 としたいです。 例えば CCをを("X1:X3")と設定するとエラーが出て上手くマクロを実行できませんでした。 現状のコード '宛先 add = .Range("V1").Value add = Mid(add, InStr(add, ":") + 1, Len(add) - InStr(add, ":")) omail.To = add add = .Range("X1").Value add = Mid(add, InStr(add, ":") + 1, Len(add) - InStr(add, ":")) omail.CC = add add = .Range("Z1").Value add = Mid(add, InStr(add, ":") + 1, Len(add) - InStr(add, ":")) omail.BCC = add 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/21 13:20 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
マクロのコード内に 指定セル値設定しておりますが、 例えば add = .Range("V1").Value omail.Subject = .Range("AG1") '件名 & .Range("AG3").Value & vbCrLf _ のコードがあります。 このコードのままだと 作業シートに指定セルを設定する事が必要ですが、 このコードの指定シートを 「省エネリスト」 と指定できる方法を教えてください。 よろしくお願いいたします。
質問日時: 2025/02/21 11:56 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると ダイアログが表示されて、保存先フォルダを指定し、指定セル値をファイル名として作業ブックを保存、 元の作業ブックはそのままで削除されません。 このマクロを ダイヤログが表示されないで、作業フォルダ内に保存できるように変更する方法を教えてください。 現状のマクロ Sub 業者用日付を更新して保存() On Error Resume Next Application.DisplayAlerts = False Const folder As String = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\" Dim newName As Variant Dim initName As String initName = folder & Range("W2").Value newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm") If newName = False Then Exit Sub Dim ws As Worksheet Dim TargetCheck As String Dim List As Variant Dim i As Long Dim Chk As Boolean 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 ThisWorkbook.SaveAs newName, xlOpenXMLWorkbookMacroEnabled Application.ScreenUpdating = True Application.Quit With ThisWorkbook .Saved = True .Close False End With End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/20 15:58 質問者: エクセル小僧
ベストアンサー
1
0
-
Vba FileSystemObject オブジェクトに使って拡張子、BaseNameを取り出す
いつもお世話になります 今、下記のプログラムでファイル一覧を取り出すテストをしていたのですが 拡張子や拡張子を除くファイル名の取り出しをスマートに記述できないかと思い投稿しました Sub Test5() Dim MyFile As Object Dim cnt As Integer Dim FilePath As String Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") FilePath = "XXXXXXXXX" cnt = 1 For Each MyFile In FSO.GetFolder(FilePath).Files ' セルにファイル情報を書き出し Cells(cnt, 1).Value = MyFile.Name ' ファイル名 Cells(cnt, 2).Value = MyFile.DateCreated ' 作成日時 Cells(cnt, 3).Value = MyFile.Size ' ファイルサイズ Cells(cnt, 4).Value = FSO.GetBaseName(MyFile.Name) ' BaseName Cells(cnt, 5).Value = FSO.GetExtensionName(MyFile.Name) ' 拡張子 cnt = cnt + 1 Next MyFile Columns("A:E").AutoFit Set FSO = Nothing End Sub 例えば、ファイル名はMyFile.Nameで取得できますがMyFile.BaseNameは出来ませんでした そこでFSO.GetBaseName(MyFile.Name)にしています、拡張子も同様で何かありそうで Webで調べてみましたが分かりませんでした MyFile.??? で拡張子やBaseNameが取れたらスマートなのにと思い相談します もし分かりましたら教えてください 以上、宜しくお願い申し上げます
質問日時: 2025/02/20 14:53 質問者: 公共ごま
ベストアンサー
2
0
-
ダブルクリックで貼り付けた画像からリンクのみ削除し、画像を残したい。
Excelのシートに以下のマクロを組みましたが、空白でダブルクリックして、写真選択。 写真をダブルクリックで貼付けまではいいのですが、画像にリンクが設定されてしまい、 元データを削除すると、貼り付けた画像まで消えてしまいます。 マクロは、詳しくないので、貼り付ければいいようにお願いいしたいです。 よろしくお願い致します。 <下記に構文を添付> Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' ターゲットセルが指定したセル(A2, C2, A4, C4, A6, C6)のいずれでもない場合、CancelをTrueに設定します。 Cancel = True ' ターゲットセルが指定したセル(A2, C2, A4, C4, A6, C6)のいずれかであれば、処理を実行します。 If Not Intersect(Target, Union(Range("ar2:ar20"), Range("at2:at20"), Range("av2:av20"), Range("ax2:ax20"), Range("az2:az20"), Range("bb2:bb20"), Range("bd2:bd20"), Range("bf2:bf20"), Range("bh2:bh20"), Range("bj2:bj20"), Range("bl2:bl20"))) Is Nothing Then ' ファイル選択ダイアログを作成します。 Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "Select an Image File" ' ダイアログのタイトルを設定します。 .Filters.Clear ' 既存のフィルターをクリアします。 .Filters.Add "Image Files", "*.GIF; *.JPG; *.JPEG; *.BMP; *.PNG; *.TIF", 1 ' 画像ファイルのフィルターを追加します。 ' ダイアログで画像が選択されたら、その画像をダブルクリックされたセルに挿入します。 If .Show = -1 Then Dim Picture As Picture Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(1)) ' 挿入した画像のサイズと位置をダブルクリックされたセルに合わせます。 With Picture With .ShapeRange .LockAspectRatio = msoFalse .Width = Target.Width * 0.85 .Height = Target.Height * 0.9 'セルの中央(横方向/縦方向の中央)に配置 .Left = Target.Left + (Target.Width - .Width) / 2 .Top = Target.Top + (Target.Height - .Height) / 1.5 End With Application.ScreenUpdating = True Cancel = True .Placement = xlMoveAndSize End With End If End With End If 変更箇所をお願いします。
質問日時: 2025/02/20 09:55 質問者: 親子丼888円
回答受付中
2
0
-
VBAの質問(Msgboxについて)です
VBA質問です。 下記のようにマクロを作りました。E2、E3、E4、E5、E6とそれぞれのセルに×が入っているときに、メッセージを出し、 〇が入っているときはメッセージを出したくありません。 また、A1に入ったタイトル名、B2、B3、B4、B5、B6とそれぞれのセルに入れた項目名(間違ったものが入っているものもある)をそれぞれ出したいのですが、マクロを実行するとB2の項目ばかり出てしまい困っています。 ※C列(C2以降)はA列(A2以降)に入った項目名とB列(B2以降)に入った項目名を結合する列として使っています。D列は都合により空欄としています。 また、E列に〇が入っているときだけメッセージが出て、×が出ているものはメッセージ表示されません。 どうしたらいいでしょうか。 どうぞよろしくお願いいたします。 Sub チェッカーMsgbox01() 'セルの値とアイコンを表示する Dim I, C As Long Dim J, D As Long Dim result As Range Dim msg As String For I = 2 To 6 '2行目~6行目まで繰り返します Set result = Range("E" & I) If result = "×" Then MsgBoxVisible = True MsgBox (Range("B" & I) & vbCrLf & Range("B" & I) & vbCrLf & Range("B" & I) & vbCrLf & Range("B" & I) & vbCrLf & Range("B" & I)) & vbCrLf, vbCritical 'メッセージボックスにA列の「名前」、「アイコン」を表示します。 End If Next I For J = 2 To 6 '2行目~6行目まで繰り返します Set result = Range("E" & J) If result = "〇" Then MsgBoxVisible = False MsgBox (Range("B" & J) & vbCrLf & Range("B" & J) & vbCrLf & Range("B" & J) & vbCrLf & Range("B" & J) & vbCrLf & Range("B" & J)) & vbCrLf, vbInformation 'メッセージボックスにA列の「名前」、「アイコン」を表示します。 End If Next J MsgBoxVisible = True MsgBox "チェック結果は以上です" End Sub
質問日時: 2025/02/19 07:07 質問者: ナカシュン太郎
ベストアンサー
2
0
-
エクセルVBA 段落番号自動取得方法
C~G列に文字列が入力されてからプログラムを実行後、B列に画像のような段落番号を表示させる方法がございましたらご教授お願いします。 画像の、"1","2","3"は表示できるようになりましたが、”2.1”や”3.1.1"など階層が深くなるとうまくいかなくて困っています。よろしくお願いいたします。
質問日時: 2025/02/18 13:24 質問者: まさゆき1016
ベストアンサー
5
1
-
Excelのマクロについて教えてください。
下記のマクロを実行すると 指定フォルダ内に指定シートと指定セル値をファイル名として、保存され、マクロ設定ブックはそのままの状態ですが、 このマクロを、 マクロを実行した時に 指定フォルダ内に指定シートと指定セル値をファイル名として、 作業ブックに上書き保存され、ブックをクローズできるように変更する方法を教えてください。 よろしくお願いいたします。 現状のマクロ Sub Macro1() Const fol As String = "\\nas-sp01\share\確認部\■意匠\戸建\戸建て電子申請関連\ひな形\" Dim fname As String, fPath As String Dim exte As String fname = Worksheets("省エネチェック").Range("W1").Text exte = ".xltm" fPath = fol & fname & exte ThisWorkbook.SaveAs Filename:=fPath, FileFormat:=xlOpenXMLTemplateMacroEnabled End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/17 13:02 質問者: エクセル小僧
ベストアンサー
4
0
-
ExcelのVBAコードについて教えてください。
ThisWorkbookに下記のコードを設定しており 最初のメッセージで「 MsgBox("解凍してよろしいですか?"」 「YES」をクリックすると マクロ「Call 解凍」が実行され 次のメッセージ「 MsgBox("軽微・フラットを確認してよろしいですか?"」 が表示されて 「YES」をクリックすると マクロ Call 軽微 Call フラット Call 交付用名前変更 Call 削除 が実行されます。 最初のメッセージ「 MsgBox("解凍してよろしいですか?"」で 「NO」をクリックすると 次のメッセージが表示されず、 マクロ Call 軽微 Call フラット Call 交付用名前変更 Call 削除 が実行されません。 最初のメッセージ「 MsgBox("解凍してよろしいですか?"」で 「NO」をクリックすると 次のメッセージが表示され、 マクロ Call 軽微 Call フラット Call 交付用名前変更 Call 削除 が実行される方法を教えてください。 現状のコード Private Sub Workbook_Open() Dim alert As VbMsgBoxResult alert = MsgBox("解凍してよろしいですか?", vbYesNo + vbQuestion, "解凍確認") If alert <> vbYes Then Exit Sub End If Call 解凍 alert = MsgBox("軽微・フラットを確認してよろしいですか?", vbYesNo + vbQuestion, "軽微・フラット確認") If alert <> vbYes Then Exit Sub End If Call 軽微 Call フラット Call 交付用名前変更 Call 削除 End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/14 09:24 質問者: エクセル小僧
ベストアンサー
1
0
-
えくせるのVBAコードについて教えてください。
作業ブックのシートに 下記のコードを設定しております。 セルD19を不特定に変更した場合に マクロ「申請の流れ着工日コピー」が実行されます。 このコードを 指定セルD19を不特定に変更した場合 且つ 指定セルB20に不特定の日付が表示された場合に のみ マクロ「申請の流れ着工日コピー」が実行できる方法を教えてください。 現状のマクロ Private Sub Worksheet_Change(ByVal Target As Range) ' 着工日等コピー If Target.Address = "$D$19" Then Call 申請の流れ着工日コピー End If End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/12 11:36 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのVBAコードについて教えてください。
作業ブックに下記のコードを設定しております。 各指定セル("B20", "F20", "H20")にそれぞれ日付が表示されると、設定マクロが実行できますが、 セル("H20")に日付を表示し、そのほかの("B20", "F20",)に日付を表示していないのに マクロが実行されてしまいます。 指定セル("B20", "F20", "H20")全てに日付が表示された場合のみにマクロを実行できる 方法を教えてください。 現状のマクロ Private Sub Worksheet_Change(ByVal Target As Range) ' ケース1 Dim checkRanges As Variant checkRanges = Array("B20", "F20", "H20") Dim isTargetChange As Boolean isTargetChange = False Dim checkRange As Variant For Each checkRange In checkRanges If Not Intersect(Target, Range(checkRange)) Is Nothing Then isTargetChange = True Exit For End If Next If Not isTargetChange Then Exit Sub If Range("B20").Value <= CDate("2025年3月31日") And _ Range("F20").Value <= CDate("2025年3月31日") And _ Range("H20").Value > CDate("2025年3月31日") Then Call 申請の流れ改正前1図表示 Call 申請の流れ改正後2図表示 Call 申請の流れケース1図表示 Call 申請の流れケース2図非表示 Call 申請の流れケース3図非表示 Call 申請の流れケース4図非表示 Call 申請の流れケース5図非表示 Call 申請の流れケース6図非表示 Call 申請の流れ施行日以降ケース図非表示 End If End Sub 以上です。 よろしくお願いいたします。
質問日時: 2025/02/11 15:53 質問者: エクセル小僧
ベストアンサー
1
1
-
VBAの「To」という語句について
1 To 3と書いた時、 ・For i=1 To 3:1と2と3を意味する(小数点は含まない) ・Case 1 To 3:1から3を意味する(小数点も含む) など、その時々で意味が違うので、混乱します。 皆さんは、どうやって覚えていますか?
質問日時: 2025/02/09 22:32 質問者: アルムの森の木
ベストアンサー
5
0
-
VBAでFOR NEXT分を Application.OnTimeを使って
Sub 練習2() Dim i As Long Dim j As Long For i = 1 To 20 j = i + 20 Cells(i, 1).Value = j Next End Sub ' Application.OnTime Now + TimeValue("00:00:05")の一文をいれて 5秒間隔でFOR文を動かしたいのですが考え方がわからずうまく動きません 完成形だとどの様な構文か教えてください。イメージとしてはセルに数字が入ったら5秒待って次の下のセルに+1の数字が入るのを繰り返すような
質問日時: 2025/02/08 21:21 質問者: goo_january
ベストアンサー
2
0
-
算術演算子「¥」の意味について
VBAには、Microsoftの公式リファレンスに掲載されていない算術演算子「¥」というのがあるようです。 その意味が分かる方がいらっしゃいましたら、ご教示頂けますとありがたいです。
質問日時: 2025/02/08 20:38 質問者: アルムの森の木
ベストアンサー
4
0
-
Excelのマクロについて教えてください。
作業ブックに下記のマクロを設定しております。 先日PCをWindows10からWindows11のVersionアップしまし処、 このマクロを実行する事が出来なくなりました。 解決方法を教えてください。 尚、コード中の「= "LBP8710 on Ne02:"」部分を「= "LBP8710 on Ne01:"」等に変更しても ダメでした。 よろしくお願いいたします。 現状のマクロ Sub 青紙印刷() '通常のプリンタを記憶 Dim myPrinter As String myPrinter = Application.ActivePrinter Sheets(Array("昇降機【青紙】(表面)", "昇降機【青紙】(裏面)")).Select Sheets("昇降機【青紙】(表面)").Activate Application.ActivePrinter = "LBP8710 on Ne02:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False 'プリンタを元に戻す Application.ActivePrinter = myPrinter End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/02/07 08:55 質問者: エクセル小僧
ベストアンサー
5
0
-
マクロVBAです。 どなたかコードをご教示いただけないでしょうか。 シート名に(チェ)がある全シート
マクロVBAです。 どなたかコードをご教示いただけないでしょうか。 シート名に(チェ)がある全シートを対象として、G2、 H2、I2…と各セルに連結記号が入力されており、 各3行目から最終行まで連結記号に対する数量(数字)があります。 したいこととしては、各列ごと連結記号に対する数量のデータ個数を最終行に太字で表示させたいです。 ☀︎注意点 D3・E3〜最終行には各列の連結記号と数量に対応する番号が書いてあります。 ですが、D・E列の数値の紐づきが重複している場合がありその場合はそれに対応するデータ個数を一意にしなければならなく重複の分、個数が合わなくなってしまいます。重複行を削除することも考えましたが、G列以降の列によって数字が入っている場合と入っていないことがあるためできません。 そのため行削除せず重複分は個数を読み込ませないようにしたいです。
質問日時: 2025/02/06 08:19 質問者: Kshfjssjashdj
解決済
2
0
-
VBAについてです。 どなたかご教示いただけないでしょうか。 データのチェックシートを作成しています
VBAについてです。 どなたかご教示いただけないでしょうか。 データのチェックシートを作成しています。 シート名に(チェ)がある全シートを対象として、G2→A、H2→B、I2→ C・・・と各セルに連結記号が入力されています。列数は毎回ランダムです。 D3・E3から最終行にはG2以降の連結記号とG3以降の数字に対応する番号が書いてあります。 ですが、D・E列の数値の紐づきが重複している場合がありその場合はそれに対応するデータ個数を一意にしなければならなく重複の分、個数が合わなくなってしまいます。重複行を削除することも考えましたが、G列以降の列によって数字が入っている場合と入っていないことがあるためできません。 そのため行削除せず重複分は個数を読み込ませないようにしたいです。
質問日時: 2025/02/05 11:09 質問者: Kshfjssjashdj
解決済
2
0
-
以下のプログラムの実行結果はどうなると思いますか? その理由も教えてください。
Sub Sample() Dim MyDate As String MyDate = "abc" MsgBox IIf(IsDate(MyDate) = True, CDate(MyDate), "?") End Sub
質問日時: 2025/01/31 17:11 質問者: アルムの森の木
ベストアンサー
4
0
-
エクセルのマクロについて教えてください。
下記のマクロを作成したいのですが、 どのようにコードを設定してよいかがわかりません、 親切にコード共教えていただける方、何卒宜しくお願い致します。 私の行いたいことを下記に列記いたします。 マクロを実行すると指定セルの文章の中の特定の文字だけを色付け(赤文字)にできる方法を教えてください。 宜しくお願い致します。 文章がある指定セルは 「C25」「D25]「E25」になります。 ‘検索して文字色を変更する特定文字は 「軽微な変更説明書」 建設評価 「変更申告書」 「軽微該当証明書」 上記文字の「」は有りです。 このVBAはあるセルを操作するたびに実行できるように設定しておりますので、 同じマクロを何度も実行しても、 キーワード以外の文字色が変更にならないようにしたいのです。 何卒、宜しくお願い致します。
質問日時: 2025/01/30 17:55 質問者: エクセル小僧
ベストアンサー
3
0
-
Vba WorkBooks.Openについて教えてください
いつもお世話になります 今、下記のプログラムをアドイン化してクイックアクセスツールバーに登録しました Sub test() Workbooks.Open "C:\temp\Sample.xlsx" End Sub 一度、Excelをすべて閉じてExcelアイコンから新規のExcelを開き、クイックツールバーから 上記のプログラムを実行すると、新規のファイルは消えてSampleの画面が表示されます しかし、プログラム実行前に新規のExcelのセルに一文字でも入力したりしてアクションしてから プログラムを実行すると新規の画面は消えず、Sampleの画面が表示されます これは、アイコンから新規の画面を開いただけではBookと認識されていないのですか? Bookの存在を調べるとBook1と出てきます(アクションを起こした後の名前も同じ) 何もアクションを起こしていないBookなのか、既存のBookなのか? もし判定方法が分かりましたら教えてください? WorkBooks.Openのオプションでも構いません 以上、宜しくお願い致します
質問日時: 2025/01/30 12:23 質問者: 公共ごま
ベストアンサー
2
0
-
質問58753 このコードでうまく動作しません。どうしたら良いですか Private Sub Wor
質問58753 このコードでうまく動作しません。どうしたら良いですか Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim mapping As Object Dim targetCell As Range Dim currentValue As String, prefix As String Dim cell As Range ' シートを指定(適宜変更) Set ws = ThisWorkbook.Sheets("Sheet1") ' DセルとBセルの対応関係 Set mapping = CreateObject("Scripting.Dictionary") mapping.Add "D3", "B80" mapping.Add "D4", "B82" mapping.Add "D6", "B85" mapping.Add "D8", "B87" mapping.Add "D12", "B90" mapping.Add "D21", "B92" mapping.Add "D25", "B94" mapping.Add "D29", "B96" mapping.Add "D31", "B98" mapping.Add "D1", "B100" mapping.Add "D2", "B102" mapping.Add "D9", "B104" mapping.Add "D11", "B106" mapping.Add "D33", "B108" ' 変更されたセルが D1:D33 以外の場合は処理しない If Intersect(Target, ws.Range("D1:D33")) Is Nothing Then Exit Sub ' 変更されたセルが複数ある場合は処理しない(Ctrl + V でも動作するが安全策) If Target.Cells.Count > 1 Then Exit Sub On Error GoTo ErrorHandler ' エラーハンドリング開始 Application.EnableEvents = False ' ① 指定セルが空白なら色を付ける Dim rngYellow As Variant, rngBlue As Variant, rngGreen As Variant rngYellow = Array("D3", "D4", "D6", "D8", "D12") rngBlue = Array("D1", "D2", "D9", "D11", "D33") rngGreen = Array("D21", "D25", "D29", "D31") ' 黄色のセル(D3, D4, D6, D8, D12) For Each cell In rngYellow If ws.Range(cell).Value = "" Then ws.Range(cell).Interior.Color = RGB(255, 255, 0) ' 黄色 Else ws.Range(cell).Interior.ColorIndex = xlNone ' 色リセット End If Next cell ' 青色のセル(D1, D2, D9, D11, D33) For Each cell In rngBlue If ws.Range(cell).Value = "" Then ws.Range(cell).Interior.Color = RGB(0, 0, 255) ' 青色 Else ws.Range(cell).Interior.ColorIndex = xlNone ' 色リセット End If Next cell ' 緑色のセル(D21, D25, D29, D31) For Each cell In rngGreen If ws.Range(cell).Value = "" Then ws.Range(cell).Interior.Color = RGB(0, 255, 0) ' 緑色 Else ws.Range(cell).Interior.ColorIndex = xlNone ' 色リセット End If Next cell ' ② Bセルの「:」の後ろにDセルの値をセット If mapping.exists(Target.Address(False, False)) Then Set targetCell = ws.Range(mapping(Target.Address(False, False))) currentValue = targetCell.Value ' 「:」の位置を探す If InStr(currentValue, ":") > 0 Then prefix = Left(currentValue, InStr(currentValue, ":")) ' 「:」までの部分を取得 If Target.Value = "" Then ' Dセルが空なら「:」の後ろを消去 targetCell.Value = prefix Else ' Dセルに値がある場合は「:」の後ろに値をセット targetCell.Value = prefix & " " & Target.Value End If Else ' 万が一「:」がない場合の処理 If Target.Value = "" Then targetCell.Value = "" Else targetCell.Value = Target.Value End If End If End If ' ③ 貼り付け時の書式設定 For Each cell In Target ' フォント設定(UDPゴシックが存在する場合のみ適用) On Error Resume Next cell.Font.Name = "UDPゴシック" On Error GoTo 0 ' フォントが存在しない場合のエラーを無視して続行 ' セルの格子線をつける With cell.Borders .LineStyle = xlContinuous .Weight = xlThin End With ' 中央揃え(水平 & 垂直) cell.HorizontalAlignment = xlCenter cell.VerticalAlignment = xlCenter Next cell ExitHandler: Application.EnableEvents = True Exit Sub ErrorHandler: ' エラーが発生した場合、イベントを有効に戻して終了 MsgBox "エラーが発生しました:" & Err.Description, vbExclamation, "エラー" Resume ExitHandler End Sub
質問日時: 2025/01/30 08:17 質問者: ゆだよ
解決済
5
0
-
エクセルのマクロについて教えてください。
作業ブックに下記のマクロを設定しております。 Sub 各シートセル位置指定() Sheets("新築").Select Range("A5").Select Sheets("変更").Select Range("A5").Select 途中省略 Sheets("増築").Select Range("A5").Select End Sub 各シートの各セル位置を設定できるようになっております。 しかし 例えば シート("新築")("増築")が表示されている場合はマクロが実行されますが、 シート("変更")が非表示の場合はエラーメッセージが表示されて上手くマクロが実行 できません。 ブックの作業の方法によってシートが表示されたり非表示になったりします。 解決方法を教えていただけますか。 一つの方法として、非表示シートを一度、すべて表示にしてから、 このマクロを実行する方法があると思いますが、それ以外の方法はありますでしょうか。 宜しくお願い致します。
質問日時: 2025/01/29 15:19 質問者: エクセル小僧
ベストアンサー
4
0
-
Excelマクロで、ピボットテーブルを起動して、月別売上表を作成したい
Excelのマクロのを使って、売上表から、マクロで、ピボットテーブルを起動して、月別売上表を自動作成したいですが、可能でしょうか? 可能でしたら、マクロのコードをどのように書けばよいか、ご教授をお願いいたします。 想定している操作は次のようです。 1. ピボットテーブルに読み込むデータの範囲は、マクロ起動前に、関数を使ってデータの件数を検出して、たとえば、売上表のセル”E1”に与え、表示しておく。 2. 写真の例では、読み込み開始位置のセルは”B3”、終了位置は”D21”をl売上表”E1”に与え、表示しておく。 3. ピボット作成マクロを起動して、ピボットテーブルを起動させて、テーブル読み込み範囲が設定してあるセル”E1”を参照して、範囲情報を取得する(B3:D21)。 4. ピボットに、ラベルを月別と金額をマクロで指定する。 5. これらにより、「月別表」というシートに、ピボットテーブルの表が表示され完成する。 よろしくお願いいたします。
質問日時: 2025/01/28 20:10 質問者: LuckyX
ベストアンサー
2
0
-
エクエルのVBAコードについて教えてください。
作業ブックに下記のコードを設定してます、 例えば 日付D6<=日付F6 日付D6>日付F6 日付D10<=日付F10/の条件が揃た時にマクロ「増築3月31日以前図表示」が実行できるように設定しましたが、このコードではうまくマクロが実行されません。 解決方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) Dim checkRanges As Variant checkRanges = Array("D6", "D8", "D10") Dim isTargetChange As Boolean isTargetChange = False Dim checkRange As Variant For Each checkRange In checkRanges If Not Intersect(Target, Range(checkRange)) Is Nothing Then isTargetChange = True Exit For End If Next If Not isTargetChange Then Exit Sub If Range("D6").Value <= CDate("F6") And _ Range("D8").Value > CDate("F8") And _ Range("D10").Value <= CDate("F10") Then End If Call 増築3月31日以前図表示 End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2025/01/26 13:04 質問者: エクセル小僧
ベストアンサー
5
0
-
ベストアンサー
2
0
-
VBAでユーザーフォームを指定回数繰り返して入力を行う方法
ユーザーフォームを使用して指定した回数分(n回)、ユーザーフォーム内の数値のデータをセルに入力をさせたいのですが、上手く動作せず無限に繰り返してしまいます。 例として、ユーザーフォーム1のtxb1に3を入力し実行、ユーザーフォーム2を表示してtxb1-7に数値データを入力して1回反映させた後、ユーザーフォーム2のtxbをクリアして2~3回目も同様な動作をさせるようにしたいです。 Sub 実行() Dim i as Integer, n as Integer i=1 n=userform1.txb1.value If i>n Then Exit Sub Else i=i+1 ActiveCells.value=userform2.txb1.value 右に1マスずらしtxbの数値を反映する同様な処理のため省略 Unload Userform2 Userform2.show Userform2.txb1.setfocus End if End sub 当方、VBA初心者の為勉強をしながら作成をしているのですが、どこを正せば上手く動くのか分からないためお教えいただきたいです。
質問日時: 2025/01/22 14:12 質問者: ぺんぎn
解決済
3
0
-
Excelのマクロについて教えてください。
下記のマクロをVBAコードで設定していますが、 何故か、同じマクロが2回程度実行されます。 このマクロを作業中に「1回」だけ実行するように出来る方法があれば、教えてください。 コード Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next On Error Resume Next If Not Intersect(Target, Range("$K$5").Text) Is Nothing Then If Range("K$5").Value = "手続き必要" Then Call 省エネ方法 End If End If End Sub マクロ Sub 省エネ方法() Dim alert n = Application.InputBox("省エネ方法を番号で入力で入力してください。" & vbCr & " " & vbLf & "1: 省エネ適判" & vbLf & "2: 仕様基準", Title:="省エネ提出方法確認", Type:=1) If n = 1 Then Call 省エネ適判 ElseIf n = 2 Then Call 仕様基準 End If End Sub 以上となります。 よろしくお願いします。
質問日時: 2025/01/21 13:26 質問者: エクセル小僧
ベストアンサー
1
0
-
ExcelのVBAコードについて教えてください。
作業シートに下記のコードを設定しております。 ExcelのVersionはoffice365になります。 指定セルD6に「3月」と表示するとマクロ「増築3月31日以前図表示」 が実行されます。 このコードを セルD6に書式設定を「yyyy"年"m"月"d"日";@」として 2025年3月31日以前の場合にマクロ「増築3月31日以前図表示」を実行できる方法を教えてください。 例えば 2025年1月21日と表示されるとマクロが実行 2025年4月1日と表示されるとマクロは非実行です。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("$D$6")) Is Nothing Then If Range("$D$6").Value = "3月" Then Call 増築3月31日以前図表示 End If End If End Sub 以上となります。 よろしくお願いします。
質問日時: 2025/01/21 09:35 質問者: エクセル小僧
ベストアンサー
1
0
-
ExcelのVBAコードについて教えてください。
下記のコードは以前教えて頂いたコードで Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim RE As Object Set RE = CreateObject("VBScript.RegExp") RE.Pattern = "^\d+$" If Not Intersect(Target, Range("$C$22")) Is Nothing Then If RE.test(Range("$C$22").Value) = True Then Call 増築建物階数図表示 End If End If End Sub セル値C22に半角英数字が入力されるとマクロ「増築建物階数図表示」が実行されrます。 セル値C22に「10.00」とか「20.00」とかを入力すると上手くマクロが実行されますが セル値C22に「10.25」とか「20.01」とかのように小数点第1・2に数字が入力されると 上手くマクロが実行されません。 解決方法を教えてください。 尚、セルC22には、書式「0.00"㎡";@」 を設定しております。 よろしくお願いします。
質問日時: 2025/01/20 17:08 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのVBAコードについて教えてください。
作業シートに下記のコードを設定しております。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("$C$5")) Is Nothing Then If Range("$C$5").Value = "都市計画内" Then Call 新築手続き必要 End If End If End Sub コードは一つの指定セル値の指定文字が表示されるとマクロ「新築手続き必要」が実行されます、 複数の指定セル値に指定文字が表示された時にマクロ「新築手続き必要」が実行できる方法を教えてください。 例えば C5="都市計画区域内" 且つ G5="3月31日以前" 且つ I5="4月01日以降" 以上の場合にマクロ「新築手続き必要」が実行できる方法を教えてください。 よろしくお願いいたします。
質問日時: 2025/01/20 08:45 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのVBAについて教えてください。
作業シートに Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("$C$23")) Is Nothing Then If Range("$C$23").Value = "増築" Then Call 増築建物規模コピー End If End If End Sub を設定してます。 指定セル値に「増築」と表示された場合にマクロ「増築建物規模コピー」 が実行されます、 このコードを 指定セルC23に不特定の半角英数字が表示された場合に マクロ「増築建物規模コピー」が実行できる方法を教えてください。 セルC23の書式設定は (0.00"㎡";@)としております。 よろしくお願いいたします。
質問日時: 2025/01/19 11:31 質問者: エクセル小僧
ベストアンサー
2
1
-
エクセルVBAで在庫の組み換え処理をしたい
エクセルVBAで在庫の組み換え処理をしたい VBAを勉強しているのですが、 例えば、袋入り個数が[バラ]、[11個] [51個] [101個] [202個]の物があり、 [11個入り]の袋から[51個入り]の袋に組み換えたい場合、 必要な[11個入り]袋の数と組み換えた余りの個数をMSGBOXに表示させたい。 また、同様に、[101個入り]の袋から[51個入り]の袋や[11個入り]の袋に組み換えた場合の、 必要な組み換え元袋数と余りの個数をMSGBOXに表示させたい いろいろ模索し下記のようなコードを試しましたがこれで良いのかわかりません。 よろしくお願いいたします。 Sub 在庫組換3() Dim 組換先入り数 As Long Dim 組換元入り数 As Long Dim 入荷組数 As Long Dim 必要な組換元組数 As Long Dim 組換えた後の残り As Long Dim 出来た組数 As Long Dim 必要な袋数 As Long ' 例:10[セット](例えば、組換先入り数51個入りが10セット入荷) 入荷組数 = Val(InputBox("入荷組数" & vbCrLf & "例:[10]セット", "入力してください。")) ' 例:51[個入り] 組換先入り数 = Val(InputBox("組換先入り数" & vbCrLf & "例:[51]個入り", "入力してください。")) ' 例:101[個入り] 組換元入り数 = Val(InputBox("組換元入り数" & vbCrLf & "例:[101]個入り", "入力してください。")) 必要な組換元組数 = Int((入荷組数 * 組換先入り数) / 組換元入り数) 組換えた後の残り = (入荷組数 * 組換先入り数) Mod 組換元入り数 出来た組数 = 入荷組数 MsgBox ("必要な組換元組数:" & 必要な組換元組数 & vbCrLf & _ "出来た袋数:" & 出来た組数 & vbCrLf & _ "組換えた後の残り:" & 組換えた後の残り) End Sub
質問日時: 2025/01/15 15:57 質問者: IrohaKujoh
ベストアンサー
1
0
-
VBAから書き込んだ条件付き初期の挙動について
お世話になります。いつも助けていただいています。表題の件につきまして,教えていただければと思います。 Range(Worksheets("sheet1").Cells(1, 2), Worksheets("sheet1").Cells(101, 14)).FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""ROW"")=ROW()").Interior.Color = rgbPowderBlue をVBAから書き込んでいますが,書き込む方法によって挙動がちがうようですので,アドバイスいただければと思います。その都度,条件付き書式設定の「ルールの管理」で確かめてみると,書き込みは行われているようです。 this workbook に Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Worksheets("sheet1").Cells.FormatConditions.Delete Range(Worksheets("sheet1").Cells(1, 2), Worksheets("受付名簿").Cells(101, 14)).FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""ROW"")=ROW()").Interior.Color = rgbPowderBlue End Sub のように記載した時だけ思った動作になります。 これを,sub にして,標準モジュールに記載し, sub きょうちょう() Worksheets("sheet1").Cells.FormatConditions.Delete Range(Worksheets("sheet1").Cells(1, 2), Worksheets("受付名簿").Cells(101, 14)).FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""ROW"")=ROW()").Interior.Color = rgbPowderBlue end sub this workbook から下記のように Private Sub Workbook_Open() call きょうちょう End Sub 呼び出すと,条件付き書式に書き込みはあるようですが,思った動作になりません。 該当のSheet1には, Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Application.ScreenUpdating = True End Sub の記述いづれもしてあります。アドバイスいただけるとたすかります。
質問日時: 2025/01/11 12:29 質問者: mabo52
ベストアンサー
2
0
-
VBA 最終行の取得がうまくいかず上書きされてしまいます。
こんにちは。 Excelを使った日報を使っており、集計シートを作成しています。 日報は1日ごとに1枚のシートを振り分けていて、必要項目だけを抽出して【1日】【2日】【3日】…と続けて集計シートに転記したいです。 シート【1日】は問題なく転記出来たのですが、【2日】を転記すると【1日】のデータに上書きされてしまいます。 【2日】以降を【集計シート】の最終行を取得して次の行から貼り付けていく方法を教えていただけないでしょうか? 日毎の日報シートA列(非表示にしています)に抽出対象がありますが、こちらは【集計シート】へは表示していません。 また【1日】から【31日】までのシートを連続で抽出貼り付けが出来るVBAも教えていただけると嬉しいです。 ただシートは【月集計】と日毎のシート以外にもいくつかあるため(集計シートは実際の日報だと4枚目にあります)、「【月集計】以外のシートで指定」するコードは使えないです。 Sub 抽出3() '抽出 Dim i, j As Long i = 5 j = 3 With Worksheets("1日") Do While .Cells(i, "B").Value <> "" If .Cells(i, "A").Value <> "" Then For x = 1 To 13 Worksheets("月集計").Cells(j, x).Value = .Cells(i, x + 1).Value Next x j = j + 1 End If i = i + 1 Loop End With End Sub よろしくお願いします。
質問日時: 2025/01/06 07:07 質問者: haru1935
ベストアンサー
5
0
-
VB.net 文字列から日付型へ変更したい
文字列で "令和7年1月05日 05時00分00秒" があります。 これを日付型の 2025/01/05 05:00:00 に変換したいのですが、 簡単なようで難しいです。
質問日時: 2025/01/05 17:49 質問者: payphone
ベストアンサー
2
1
-
VBAでエクセルのテキストデータをクリップボードに格納したい。
エクセルのA1~A10にdata1~data10というデータがあるとします。 このdata1~data10というセルごとの値をクリップボードにそれぞれ格納するにはどうしたらいいでしょうか? コントロール+Cでコピーをすればクリップボードにそれぞれのセルの値(data1~data10)が格納されるのですが、同じことをVBAでしてもクリップボードには格納できないですよね? エクセルで作ったデータを別のアプリにコピペする必要があるのですが、いちいちコピペすると大変なのでまとめてクリップボードに格納にウィンドウズキー+Vでクリップボードから選択してペーストすることを考えています。 なお、別のアプリにCSVでインポートするにはアプリの改変が必要で費用がかかるということで、インポートする方法はできません。(~_~;)
質問日時: 2025/01/04 09:12 質問者: CaveatEmptor
ベストアンサー
2
0
-
ExcelのVBAコードについて教えてください。
下記のコードは以前、マクロを繰り返し実行される不具合を解決するために、教えて頂いたコードですが、やはり指定セル値指定文字が表示されるとマクロ「省エネ方法」が繰り返し実行されます。 例えば「省エネ方法」が実行されて「1」を入力し、(OK)をクリックするともう一度、同じマクロが実行されてしまいます。(キャンセル)をクリックすると次のコードが実行されますが、次のコードで違うマクロを実行すると、またまた「省エネ方法」が実行されます。 マクロ「省エネ方法」を繰り返し実行しない方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("$A$5,$A$13").Text) Is Nothing Then If Range("$A$5").Text = "新築" And Range("$A$13").Text = "手続き必要" Then Call 省エネ方法 End If End If End Sub ちなみに If Not Intersect(Target, Range("$A$5").Text) Is Nothing Or _ Not Intersect(Target, Range("$A$13").Text) Is Nothing Then If Range("$A$5").Text = "新築" And Range("$A$13").Text = "手続き必要" Then Call 省エネ方法 End If End If このコードに変更しても同様です。 よろしくお願いいたします。
質問日時: 2024/12/27 09:14 質問者: エクセル小僧
ベストアンサー
7
0
-
Excel VBAについて。こんな動作をさせるためにはどう書けばよいでしょうか。
添付のような表があります。(実際は100行くらいあります) 例えばAさんは1/13,14,15と滞在する予定になっていますが、 日ごとに何人が滞在しているかカウントするマクロが作りたいです。 ボタンを押すと、1/13は何人、1/14は何人、、と結果が出てくるのが理想です。 また、(これはできればなのですが)BさんのようにD列に「前泊」という文字がある人については出発日の翌日から滞在としたいです。例えばBさんは1/15~17で滞在ということになります。 マクロ初心者なのですが調べようにもなんて調べたらいいのかも分からず、得意な方がいらっしゃれば教えていただきたいですm(__)m ボタンの作り方や変数の定義など基本的な部分はネットで調べて分かるようになりました
質問日時: 2024/12/26 18:29 質問者: imuy999
ベストアンサー
10
0
-
ExcelのVBAコードについて教えてください。
作業ブックのシートに Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("AL10")) Is Nothing Then If Range("AL10").Value = "手続き必要" Then Call 矢印9表示 End If End If End Sub を設定しており、 指定セル値AL10に(手続き必要)と表示されたら、 マクロ Call 矢印9表示 が実行できるように設定しましたが、 AL10に(手続き必要)と表示されても 上手くマクロが実行できませんでした。 セルAL10には数式「=$AL$2&""&$AL$3&""&$AL$4&""&$AL$5&""&$AL$6&""&$AL$7&""&$AL$8&""&$AL$9」を設定しておりまして、この数式に表示された文字をセルAL10に表示させてます。 解決方法を教えてください。 よろしくお願いいたします。
質問日時: 2024/12/25 14:32 質問者: エクセル小僧
ベストアンサー
3
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると「メッセージボックス」が表示され、「OK」をクリックすると Call 着工時期 が実行されるようしてますが、 「OK」をクリックしても Call 着工時期 が実行されません、 解決方法を教えてください。 現状のマクロ Sub 着工日確認() Dim alert alert = MsgBox("一般的には" & vbLf & " " & vbLf & "「くい打ち工事」" & vbLf & "「地盤完了工事」" & vbLf & "「山留工事」」" & vbLf & "「根切り工事」" & vbLf & "に係る工事が開始開始された時点を言います。", vbYes + vbExclamation, "着工日の考え方") Select Case alert Case vbYes: Call 着工時期 End Select End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/12/25 12:05 質問者: エクセル小僧
ベストアンサー
4
0
-
不要項目の行削除方法について
EXCEL_VBA初心者です。 大変申し訳ございませんが行削除EXCEL_VBAコードについてご教授願います。 「対象シート」に果物の項目があり A列:種類No、B列:種類、C列:名称No、D列:名称、E列:金額 となっています。 この「対象シート」から必要な果物以外を行ごと削除したいと思っています。 「対象項目」のシートのA列に削除したい果物の種類Noが記載されています 「対象項目」のシートのC列には削除されたくない果物の名称Noが記載されています。 分かり難いのですが、「対象項目」のシートの種類に記載されている果物で名称に記載されている果物は削除せず、それ以外を削除したいです。 例えば、果物の種類No :01みかんの場合はAA清美、ABマドンナ、AE不知火の3名称は削除せず、その他のACセトカ、ADデコポンは削除する。 07柿の場合はCA富有柿は削除せず、CB おけさ柿は削除する 「対象シート」が「削除後」シートの結果になるEXCEL_VBAコードを教えて下さい。 実際は果物の品種は数十種類となり「対象シート」も何百行にもなります。 よろしくお願いします。
質問日時: 2024/12/23 10:21 質問者: cake
ベストアンサー
8
0
-
【マクロ】オートフィルターにて12/1以上12/3以下のコード。日付はセルに入力。教えて下さい
以下コードをご覧ください。動きます。 日付の指定をセルA1に12/1以上。セルA2に12/3以下 を入力したいです コード書き方ご存じの方、教えて下さい ws1.Range(Cells(1, 1), Cells(10, 3)).autofilter 1, ">=2024/12/1", xlAnd, "<=2024/12/3"
質問日時: 2024/12/20 07:50 質問者: aoyama-reiko
ベストアンサー
3
0
-
Excelのマクロについて教えてください。
下記の2つのマクロを1つに出来る方法を教えてください。 このマクロは以前教えて頂いたマクロで、マクロを実行すると 指定ファイルが指定フォルダ内に移動します。 マクロ-1 Sub 交付用に移動A3() On Error Resume Next Dim myPath As Variant Dim fPath As String, fname As String fPath = ThisWorkbook.Path ' myPath 変数にフォルダパスを取得 myPath = folder_acquisition(fPath) ' 「交付用_A3」で終わるPDFファイルを取得 fname = Dir(myPath(1) & "*(交付用_A3).pdf") Do While fname <> "" ' ファイルの移動を実行 Name myPath(1) & fname As myPath(2) & fname fname = Dir Loop End Sub Function folder_acquisition(fPath As String) As Variant() Dim fso As Object, f As Object Dim n As Integer Dim myPath(2) As Variant Set fso = CreateObject("Scripting.FileSystemObject") ' 現在のフォルダ内のPDFファイルがあるパスを取得 myPath(1) = fPath & "\" ' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける For Each f In fso.GetFolder(fPath).SubFolders Dim folderName As String folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1) ' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合 If folderName Like "########-#_交付用" Then myPath(2) = f.Path & "\" n = n + 1 End If ' 必要なフォルダが見つかったら終了 If n = 2 Then Exit For Next f Set fso = Nothing folder_acquisition = myPath() End Function マクロ-2 Sub 交付用に移動A4() On Error Resume Next Dim myPath As Variant Dim fPath As String, fname As String fPath = ThisWorkbook.Path ' myPath 変数にフォルダパスを取得 myPath = folder_acquisition(fPath) ' 「交付用_A3」で終わるPDFファイルを取得 fname = Dir(myPath(1) & "*(交付用_A4).pdf") Do While fname <> "" ' ファイルの移動を実行 Name myPath(1) & fname As myPath(2) & fname fname = Dir Loop End Sub Function folder_acquisition(fPath As String) As Variant() Dim fso As Object, f As Object Dim n As Integer Dim myPath(2) As Variant Set fso = CreateObject("Scripting.FileSystemObject") ' 現在のフォルダ内のPDFファイルがあるパスを取得 myPath(1) = fPath & "\" ' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける For Each f In fso.GetFolder(fPath).SubFolders Dim folderName As String folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1) ' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合 If folderName Like "########-#_交付用" Then myPath(2) = f.Path & "\" n = n + 1 End If ' 必要なフォルダが見つかったら終了 If n = 2 Then Exit For Next f Set fso = Nothing folder_acquisition = myPath() End Function 以上となります。 よろしくお願いいたします。
質問日時: 2024/12/18 09:25 質問者: エクセル小僧
ベストアンサー
1
0
-
VBA 同じフォルダ内のすべてのファイルに同じセルをペーストしたい
VBAについてのご質問です。 ”データ処理ファイル”というファイルの”データ処理シート”というシートの”B1:S110000”セルをコピーして 同じフォルダ内のすべてのファイルの”あ”というシートの”B1:S110000”セルにペーストしたいです。 自分なりに下記のように作ってみましたが一部でエラーが出てしまいうまく動作しません。 お手数をおかけしますが、どのように修正すればよいかご教示いただけますでしょうか。 また、全然違うようでしたらサンプルコードをいただけないでしょうか? 差し出がましい質問で大変恐縮ですが、ご教示いただけると幸いです。 Sub 粗さデータ処理() Dim fileName As String Dim wsName As String: wsName = "粗さデータ" '対象ワークシート名 Application.ScreenUpdating = False '各ファイルの変更処理を表示させない Application.DisplayAlerts = False '保存時メッセージを表示させない ChDir ThisWorkbook.Path fileName = Dir("*.xlsx?") 'フォルダ内の最初のエクセルファイル名を取得 Do While fileName <> "" If fileName <> ThisWorkbook.Name Then 'マクロのあるファイルでなければ With Workbooks.Open(fileName) 'ファイルオープン ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy_ .Worksheets(wsName).Range("B1").Select .Close savechanges:=True '保存&クローズ End With End If fileName = Dir() 'フォルダ内の次のエクセルファイル名を取得 Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy_でエラーが出ています。
質問日時: 2024/12/17 01:19 質問者: あずきぬし
ベストアンサー
3
0
-
vba Windowオブジェクト(Windows(index))について教えてください
いつもお世話になります 昔作ったプログラムを見直ししていて、ちょっと疑問になったので教えてください ウェブを見ると オブジェクトを返すには、Windows (index) を使用しますとありますが、 (質問1) アクティブウィンドウは常にWindows(1)なのでしょうか? (質問2) そしていま、ウィンドウのタイトルバーにブック名を出力しうとしているみたいですが これで良いのでしょうか? MyBook as string Dim wds as Window MyBook = ActiveWorkBook.name Set wds = ActiveWorkBook.Windows(1) wds.Caption = MyBook あまり必要がないみたいですが、プログラムにコメントを残したいので教えてください 以上、宜しくお願い申し上げます
質問日時: 2024/12/16 18:10 質問者: 公共ごま
ベストアンサー
1
0
-
Vba エラーコード2147xxxxxxについて教えてください
いつもお世話になります 今、ExcelからDocuworksの操作を与えられた関数から仕事をしています rc = XDW_GetDocumentNameInBinder(lngHandle, k, fName(0), Ksize, vbNullString) バインダーファイルからファイル名を取得するのですが、正常値はそのバイト数が得られますが ファイル名がなくなるとエラーコードとなります そのエラーコードで質問ですが Excel32ビット版の時は、-2147xxxxxxと負の値だったので if RC < 0 Then Exit Sub チェックできたのですが Excel64ビット版では正の値で 2147xxxxxxxで出てくるのでそのあとに if Abs(RC) > 2147000000 Then Exit Sub としました そこで、これ良いのかな? っと思っています また環境が変わっても使えそうなものが他にあるような気がして相談してみました 以上、何か良いと思うものが有ったら教えてください 以上、宜しくお願い致します
質問日時: 2024/12/14 16:10 質問者: 公共ごま
ベストアンサー
1
1
-
ExcelのVBAコードについて教えてください。
下記のコードは以前教えて頂いたコードで If Not Intersect(Target, Range("C5")) Is Nothing Then If Range("C5").Value = "都市計画区域内" Then Call 申請時期 End If End If 指定セル値に指定文字が表示されると マクロが実行されます、又、繰り返しのマクロ実行を防いでます。 このコードだと、指定セルが同じセルでのコードになりますが、 If Not Intersect(Target, Range("C5")) Is Nothing Then If Range("C5").Value = "都市計画区域内" Then この部分を If Range("C5").Value = "都市計画区域外" And Range("E5").Value = "階数:2階以上又は200㎡を超える" Then に変更し、マクロを繰り返し実行できない方法を教えてください。 よろしくお願いいたします。
質問日時: 2024/12/05 16:25 質問者: エクセル小僧
ベストアンサー
4
0
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
カスハラとクレームの違いは?カスハラの法的責任は?企業がとるべき対応は?
東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。 この動きは自治体...
-
なぜ批判コメントをするの?その心理と向き合い方をカウンセラーにきいた!
今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
-
大麻の使用罪がなかった理由や法改正での変更点、他国との違いを弁護士が解説
ドイツで2024年4月に大麻が合法化され、その2ヶ月後にサッカーEURO2024が行われた。その際、ドイツ警察は大会運営における治安維持の一つの方針として「アルコールを飲んでいるグループと、大麻を吸っているグループ...
-
ピンとくる人とこない人の違いは?直感を鍛える方法を心理コンサルタントに聞いた!
根拠はないがなんとなくそう感じる……。そんな「直感がした」という経験がある人は少なくないだろう。ただ直感は目には見えず、具体的な説明が難しいこともあるため、その正体は理解しにくい。「教えて!goo」にも「...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelのマクロについて教えてくださ...
-
Excelのマクロについて教えてくださ...
-
Excelのマクロについて教えてくださ...
-
ダブルクリックで貼り付けた画像か...
-
VBAの質問(Msgboxについて)です
-
Vba FileSystemObject オブジェクト...
-
現在のブックを閉じないで、マクロ...
-
ExcelのVBAコードについて教えてく...
-
エクセルVBA 段落番号自動取得方法
-
Excelのマクロについて教えてくださ...
-
VBAでエクセルのテキストデータをク...
-
算術演算子「¥」の意味について
-
Excelのマクロについて教えてくださ...
-
エクエルのVBAコードについて教えて...
-
VBAの「To」という語句について
-
エクセルのVBAについて教えてくださ...
-
vba Windowオブジェクト(Windows(in...
-
WindowsのOutlook を VBA から操作する
-
質問58753 このコードでうまく動作...
-
Excelのマクロについて教えてくださ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VB.net 文字列から日付型へ変更したい
-
VBA 最終行の取得がうまくいかず上...
-
VBAでエクセルのテキストデータをク...
-
【ExcelVBA】5万行以上のデータ比...
-
エクセルVBAで在庫の組み換え処理を...
-
VBAから書き込んだ条件付き初期の挙...
-
エクセルのVBAコードについて教えて...
-
VBAでユーザーフォームを指定回数繰...
-
エクセルのVBAについて教えてくださ...
-
vbaマクロについて
-
ExcelのVBAコードについて教えてく...
-
【VBA】 結合セルに複数画像とファ...
-
WindowsのOutlook を VBA から操作する
-
質問58753 このコードでうまく動作...
-
ExcelのVBAコードについて教えてく...
-
Excel VBAについて。こんな動作をさ...
-
[Excel VBA]特定の条件で文字を削除...
-
[VB.net] ボタン(Flat)のEnable時の...
-
エクエルのVBAコードについて教えて...
-
ExcelのVBAコードについて教えてく...
おすすめ情報