回答数
気になる
-
ダブルクリックで貼り付けた画像からリンクのみ削除し、画像を残したい。
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 段落番号自動取得方法
C~G列に文字列が入力されてからプログラムを実行後、B列に画像のような段落番号を表示させる方法がございましたらご教授お願いします。 画像の、"1","2","3"は表示できるようになりましたが、”2.1”や”3.1.1"など階層が深くなるとうまくいかなくて困っています。よろしくお願いいたします。
質問日時: 2025/02/18 13:24 質問者: まさゆき1016
ベストアンサー
5
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
-
4
以下のプログラムの実行結果はどうなると思いますか? その理由も教えてください。
Sub Sample() Dim MyDate As String MyDate = "abc" MsgBox IIf(IsDate(MyDate) = True, CDate(MyDate), "?") End Sub
質問日時: 2025/01/31 17:11 質問者: アルムの森の木
ベストアンサー
4
0
-
5
質問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
-
6
ベストアンサー
2
0
-
7
VBA ユーザーフォーム ボタンクリック後にセルにフォーカス
VBAのユーザーフォームについて質問です。 ユーザーフォーム上のコマンドボタンをクリックすると、セルに値が入力されるようにしました。このとき、コマンドボタンをクリックすると、フォーカスがユーザーフォームに残っています。これを、コマンドボタンをクリックした後、自動で対象のセルにフォーカスすることはできるでしょうか?何かよい方法はあるでしょうか? イメージは、 1 コマンドボタンクリック 2セルに値がセットされる 3 マウスを手放す 4 キーボードからセルの操作ができる状態(キーボードの矢印キーでセル移動ができる状態など) のような状態にしたいです。
質問日時: 2024/05/16 02:17 質問者: tsukita
ベストアンサー
3
0
-
8
エクセルのVBAコードについて教えてください。
作業シートに Private Sub Worksheet_Change(ByVal Target As Range) Sheets("消防の指摘一覧(参考資料)").Visible = [E114] = True End Sub を設定しております。 チェックボック15をにチェックを入れるとセルE114に「True」と表示され、 非表示シート「消防の指摘一覧(参考資料)」が表示できるように設定しましが、 チェックを入れても非表示シートが上手く表示されません。 又、セルE114に直接「True」と入力すると非表示シートが表示されました。 この解決方法を教えてください。 よろしくお願いいたします。
質問日時: 2025/03/15 12:33 質問者: エクセル小僧
ベストアンサー
1
1
-
9
Excelマクロで使うVBAコードをスプレッドシートのGoogle Apps Scriptに変換
Excelマクロで使用しているVBAコードをスプレッドシートのGoogle Apps Scriptに変換していただきたいです。 Sub hogo() 'ActiveSheet.Protect AllowFormattingCells:=True 'セル書式化 ActiveSheet.Protect AllowFormattingRows:=True '行を書式化 End Sub Sub 並び替え() ' ActiveSheet.Unprotect Rows("7:56").Select 'ActiveWorkbook.Worksheets("1").Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Add Key:=Range("BE8:BE56"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveSheet.Sort .SetRange Range("A7:OS56") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B8").Select On Error Resume Next 'ActiveSheet.Protect AllowFormattingCells:=True 'セル書式化 ActiveSheet.Protect AllowFormattingRows:=True '行を書式化 End Sub
質問日時: 2025/02/28 12:21 質問者: gogiradaisuki
ベストアンサー
1
0
-
10
【マクロ】値を渡されたプロシージャから実行すると、渡したプロシージャを選択される?
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
-
11
【マクロ】モジュール変数の記述時、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
-
12
えくせるの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
-
13
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
-
14
エクセルのマクロについて教えてください。
下記のマクロを作成したいのですが、 どのようにコードを設定してよいかがわかりません、 親切にコード共教えていただける方、何卒宜しくお願い致します。 私の行いたいことを下記に列記いたします。 マクロを実行すると指定セルの文章の中の特定の文字だけを色付け(赤文字)にできる方法を教えてください。 宜しくお願い致します。 文章がある指定セルは 「C25」「D25]「E25」になります。 ‘検索して文字色を変更する特定文字は 「軽微な変更説明書」 建設評価 「変更申告書」 「軽微該当証明書」 上記文字の「」は有りです。 このVBAはあるセルを操作するたびに実行できるように設定しておりますので、 同じマクロを何度も実行しても、 キーワード以外の文字色が変更にならないようにしたいのです。 何卒、宜しくお願い致します。
質問日時: 2025/01/30 17:55 質問者: エクセル小僧
ベストアンサー
3
0
-
15
Excelマクロで、ピボットテーブルを起動して、月別売上表を作成したい
Excelのマクロのを使って、売上表から、マクロで、ピボットテーブルを起動して、月別売上表を自動作成したいですが、可能でしょうか? 可能でしたら、マクロのコードをどのように書けばよいか、ご教授をお願いいたします。 想定している操作は次のようです。 1. ピボットテーブルに読み込むデータの範囲は、マクロ起動前に、関数を使ってデータの件数を検出して、たとえば、売上表のセル”E1”に与え、表示しておく。 2. 写真の例では、読み込み開始位置のセルは”B3”、終了位置は”D21”をl売上表”E1”に与え、表示しておく。 3. ピボット作成マクロを起動して、ピボットテーブルを起動させて、テーブル読み込み範囲が設定してあるセル”E1”を参照して、範囲情報を取得する(B3:D21)。 4. ピボットに、ラベルを月別と金額をマクロで指定する。 5. これらにより、「月別表」というシートに、ピボットテーブルの表が表示され完成する。 よろしくお願いいたします。
質問日時: 2025/01/28 20:10 質問者: LuckyX
ベストアンサー
2
0
-
16
エクエルの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
-
17
不要項目の行削除方法について
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
-
18
VBA Application.Matchについての質問です
商品管理にマクロを使用しています。W列に仕入日、X列に仕入れ品名、Y、Z、AAには内容物の個数を入力しています。AL列には販売済み品名、AM,AN,AOには数字が入っていますが基本1に想定しています。仕入れ品は1箱に複数個のものもあり、便宜上個々としてバラす(AA列の数)必要があります。X:AAは仕入れ品名と日付で昇順し、販売済み品は同一の品名を統合し、数字は合算した形からAAをバラさずにApplication.Matchを実行すると完璧に走ってくれることは確認できています。つぎにAAをバラすため 、別シートからX1に貼り付けたのちに Dim i As Variant For i = Cells(Rows.Count, "AA").End(xlUp).Row To 1 Step -1 If Cells(i, "AA").Value > 1 Then Range(Cells(i, "W"), Cells(i, "AA")).Copy Range(Cells(i + 1, "W"), Cells(i + 1, "AA")).Resize(Cells(i, "AA").Value - 1).Insert End If Next Application.CutCopyMode = False を追加すると、X列の途中(AL列の統合前の最終行?)までしか見に行かずに”見当たりません”のメッセージが返ってきます。 あらかじめ別シートでバラしてから本シートのX1に貼り付けてVBAを走らせても結果は同じで止まります。 バラにしなければ走る、VBAを追加すると止まるのはなぜでしょうか?どこかを修正すればX列を最後まで検索してくれるようになるのでしょうか。 さほど知識がないので何日も考え、試しています。 是非ともご教授お願いいたします。
質問日時: 2024/11/25 14:10 質問者: mokatsu
ベストアンサー
4
0
-
19
Excelのマクロについて教えてください。
下記マクロを実行すると ダイアログが開き、マウスで指定したPDFファイルを指定シートの指定セル値に設定しているファイル名に変更できます。 このマクロを下記の様に変更できる方法を教えてください。 マクロ設定ブックと同じフォルダ内に PDFファイル名が「A4」「A3」(固定のファイル名)となっているファイルがあります、 ダイアログを開かずに PDFファイル名が「A4」のファイル名をシート「昇降機質疑」セル値「V3」に設定しているファイル名に変更 PDFファイル名が「A3」のファイル名をシート「昇降機質疑」セル値「V9」に設定しているファイル名に変更 できる方法を親切にコード迄教えてください。 現状のマクロ Sub 交付用名前変更A4() Dim TargetFile As String Dim fPath As String, fname As String Dim newfName As String newfName = ThisWorkbook.Sheets("昇降機質疑").Range("V3").Value & ".pdf" newfName = NGNarrowToWide(newfName) ''メッセージを表示し、実施確認する。 If MsgBox(newfName & vbCrLf & vbCrLf & "(交付用_A4)を作成しますか。", vbExclamation + vbOKCancel) <> vbOK Then Exit Sub ' ファイルのパスを指定 fPath = ThisWorkbook.Path ' ダイアログを表示してファイルを選択 TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf", , "ファイルを選択", , False) If TargetFile = "False" Then Exit Sub ' ファイル名を変更 If TargetFile = fPath & "\" & newfName Then MsgBox "同名ファイルを選択しています" Exit Sub End If If Not Dir(fPath & "\" & newfName) <> "" Then Name TargetFile As fPath & "\" & newfName Else Dim rc As Integer rc = MsgBox("既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", 52, "置き換え確認") If rc = vbYes Then Application.DisplayAlerts = False Kill fPath & "\" & newfName Name TargetFile As fPath & "\" & newfName Application.DisplayAlerts = True Else MsgBox "処理を中止しました" End If End If End Sub Public Function NGNarrowToWide(ByVal stg As String) As String stg = Replace(Replace(Replace(Replace(stg, "\", "¥"), "/", "/"), ":", ":"), "*", "*") stg = Replace(Replace(Replace(Replace(stg, "?", "?"), "<", "<"), ">", ">"), "|", "|") stg = Replace(stg, """", Chr(&H8168)) NGNarrowToWide = stg End Function 以上となります。 宜しくお願い致します。
質問日時: 2024/11/14 09:43 質問者: エクセル小僧
ベストアンサー
5
0
-
20
【ExcelVBA】dictionaryの重複判断の基準(セル結合だと違う値として認識される)
重複データを抽出したく試していますが、以下で詰まっています。 例えば、 A、B、C列のデータを連結したものを比較対象とし、 複数行あるものから重複データを抽出したいのですが、 「&」で繋げたものを比較すると、違うものとみなされます。 A1、B1、C1を連結したものを111(A1に1、B1に1、C1に1)とし、 A2、B2、C2を連結したものを111(A2に1、B2に1、C2に1)とした場合、 dictionaryを使って、重複データを抽出している途中ですが、 「111」と「111」が違うものとして判断されてしまいますが、 同じだからエラー(既に割り当てられてる)で止まります(結合しなければ、機能します)。 一旦シート上で結合したものを値貼り付けに変えて、それをチェック対象にするしかないでしょうか? データは数万行あります。 ご存知の方、ご教示お願いします。 <以下コード(コードは自分で考えたものではなく一部流用で、抽出できたら整形します)> Sub test() Dim i As Long Dim j As Long Dim maxRow As Long Dim dic As Object Dim strMat, lngNum Set dic = CreateObject("scripting.dictionary") j = 2 'リスト書き出し開始行 With ActiveSheet maxRow = .Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To maxRow strMat = .Cells(i, 2).Value & .Cells(i, 3).Value & .Cells(i, 4).Value←ここ If dic.Exists(strMat) Then ' 重複してる .Cells(dic.Item(strMat), 7).Value = strMat Else ' 重複してない dic.Add (.Cells(i, 2).Value), j j = j + 1 End If Next i End With end sub
質問日時: 2024/10/08 22:09 質問者: yoshikadu
ベストアンサー
4
0
-
21
【VBA】 結合セルに複数画像とファイル名一括挿入する方法
ご覧いただきありがとうございます。 VBA初心者です。 ダイアログボックスを開き画像ファイルを選択、1行目が見出し行になっている表のB2から6行ごとに結合したセルに画像を挿入し、隣のC列(6行ごと結合)に画像ファイル名(拡張子なし)が入る表を作りたいです。 結合していないセルの場合、以下のコードで作成できました。 6行ごとに結合したセルの場合は、どのように修正したらいいのでしょうか? 詳しい方、よろしくお願いいたします。 Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "Select Image Files" .Filters.Clear .Filters.Add "Image Files", "*.GIF; *.JPG; *.BMP; *.PNG; *.TIF", 1 .AllowMultiSelect = True If .Show = -1 Then Dim i As Long For i = 1 To .SelectedItems.Count Dim fileName As String fileName = Left(Dir(.SelectedItems(i)), Len(Dir(.SelectedItems(i))) - 4) Range("C" & i + 1).Value = fileName Dim Picture As Picture Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(i)) With Picture With .ShapeRange .LockAspectRatio = msoFalse .Width = Range("B" & i + 1).Width .Height = Range("B" & i + 1).Height End With .Left = Range("B" & i + 1).Left .Top = Range("B" & i + 1).Top .Placement = xlMoveAndSize End With Next i End If End With End Sub
質問日時: 2024/10/03 21:59 質問者: ukr-pm
ベストアンサー
1
0
-
22
vba 削除
質問ですシートに値の一覧が複数あります。それを条件に基づいて行を削除したいです。 条件ですが画像の2行目、3行目のようにa2、b2、c2、a3、b3、c3セルの内容が同じでd2が空白、d3は文字が入っています。この2行がペアでe列が両方okなら合格で5行目、6行目のように片方にngがあればそのペアは不合格です。この条件でシートに一覧で並んでいるものを振り分けて不合格ならそのペアの両方の行を削除するVBAを作りたいです。初めはngを検索して削除していたのですがそれだとokが残ってしまいますがペアで揃って合格なので一つだけしかないものも削除したいです。 説明が難しいのとヘタでわかりにくいと思いますが、理解してくださった方おられれば教えて下さい
質問日時: 2024/06/04 21:05 質問者: ケイ0000
解決済
3
0
-
23
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
-
24
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
-
25
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
-
26
エクセルの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
-
27
エクセルの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
-
28
エクセル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
-
29
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
-
30
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
-
31
VB.net 文字列から日付型へ変更したい
文字列で "令和7年1月05日 05時00分00秒" があります。 これを日付型の 2025/01/05 05:00:00 に変換したいのですが、 簡単なようで難しいです。
質問日時: 2025/01/05 17:49 質問者: payphone
ベストアンサー
2
1
-
32
VBAでエクセルのテキストデータをクリップボードに格納したい。
エクセルのA1~A10にdata1~data10というデータがあるとします。 このdata1~data10というセルごとの値をクリップボードにそれぞれ格納するにはどうしたらいいでしょうか? コントロール+Cでコピーをすればクリップボードにそれぞれのセルの値(data1~data10)が格納されるのですが、同じことをVBAでしてもクリップボードには格納できないですよね? エクセルで作ったデータを別のアプリにコピペする必要があるのですが、いちいちコピペすると大変なのでまとめてクリップボードに格納にウィンドウズキー+Vでクリップボードから選択してペーストすることを考えています。 なお、別のアプリにCSVでインポートするにはアプリの改変が必要で費用がかかるということで、インポートする方法はできません。(~_~;)
質問日時: 2025/01/04 09:12 質問者: CaveatEmptor
ベストアンサー
2
0
-
33
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
-
34
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
-
35
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
-
36
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
-
37
【マクロ】オートフィルターにて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
-
38
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
-
39
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
-
40
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
-
41
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
-
42
ExcelのVBAコードについて教えてください。
作業ブックの作業シートにVBAコードを設定してます。 このコードは先日教えて頂いたコードを少しアレンジしております。 このコードは指定セル値「C5」に指定文字が表示された場合に指定マクロが実行されます。 このコードを 指定セル値「C5」に不特定の文字が表示された場合に指定マクロが実行できるように変更する方法を教えてください。 現状のマクロ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("C5")) Is Nothing Then If Range("C5").Value = "新築" Then Call 建物面積 End If End If End Sub
質問日時: 2024/12/04 13:24 質問者: エクセル小僧
ベストアンサー
1
0
-
43
Excelのマクロについて教えてください。
下記のマクロを実行すると メッセージボックスが表示され、「はい(Y)」をクリックすると マクロ「Call 都市計画区域内」が実行されます。 このマクロを 画像のようにメッセージボックスの表示を 「区域内」「区域外」「キャンセル」として 「区域内」をクリックするとマクロ「Call 都市計画区域内」が実行 「区域外」をクリックするとマクロ「Call 都市計画区域外」が実行 「キャンセル」をクリックするとマクロ実行されないように変更する方法を教えてください。 現状のマクロ Sub 都市計画() alert = MsgBox("都市計画区域", vbYesNo + vbQuestion, "都市計画確認") If alert <> vbYes Then Exit Sub End If Call 都市計画区域内 End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/12/04 10:13 質問者: エクセル小僧
ベストアンサー
2
0
-
44
VBAについて教えて下さい
お世話になります。 excel2019で作成したVBAはexcel2013で動かす事は出来ないのでしょうか?動かない場合はexcel2013とexcel2019に搭載されているマクロや関数の違いよるのでしょうか。対処法などは有りますでしょうか。 ご教授宜しくお願い致します。
質問日時: 2024/12/04 00:44 質問者: mokatsu
ベストアンサー
4
0
-
45
Excelの数式について教えてください。
下記の条件で「シート名昇降機【青紙】(表面)」のセル「CB5」に数字を表示できる方法を教えてください。 条件 シート名「基本情報」のセルにプルダウンで文字が表示されます。 例えば №1号機 №1号機~№2号機 №3号機~№4号機 №3号機~№5号機 等々 この表示された文字を以下のように数字にしたいのですが、 №1号機=1 №1号機~№2号機=2 №3号機~№4号機=2 №3号機~№5号機=3 のように№で表示された数字の数を数字に出来る方法を教えてください。 よろしくお願いいたします。
質問日時: 2024/12/03 10:09 質問者: エクセル小僧
ベストアンサー
1
0
-
46
ExcelのVBAコードについて教えてください。
作業ブックのThisWorkbookに下記のコードを設定しています。 ブックを開くとメッセージボックスが表示されて、 はい(Y)をクリックすると以下のマクロが実行されます。 いいえ(N)をクリックするとマクロが実行されません。 このコードを はい(Y)の代わりに「新築」と表示し、それをクリックするとマクロ「新築シート表示」が実行 同じく 「増築」と表示し、それをクリックするとマクロ「増築シート表示」が実行 「変更」と表示し、それをクリックするとマクロ「変更シート表示」が実行 「キャンセル」と表示し、それをクリックするとすべてのマクロが非実行 に出来る方法を教えてください。 現行のコード Private Sub Workbook_Open() Dim alert As VbMsgBoxResult alert = MsgBox("シートを表示しますか?", vbYesNo + vbQuestion, "シート確認") If alert <> vbYes Then Exit Sub End If Call 新築シート表示 Call 増築シート表示 Call 変更シート表示 End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/12/03 09:10 質問者: エクセル小僧
ベストアンサー
2
0
-
47
Excelのマクロについて教えてください。
下記のマクロを実行するとセル値の番号の該当フォルダが指定フォルダから指定フォルダ内に移動出来るマクロになっております。 このマクロの実行は、シート名「物件管理」にVBA Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Range("AE79").Value = "該当" Then Call フォルダ移動 End If End Sub を設定して実行しております。 しかし、マクロを実行後に、対象フォルダを移動済みの場合でも、シート「物件管理」上で作業をする度に、メッセージ「フォルダを移動しますか?」が表示されてしまいます。 対象フォルダが移動済み又は、メッセージが表示されて「はい(Y)を1回クリックすることで シート「物件管理」上で作業をする度に、メッセージ「フォルダを移動しますか?」が非表示となる方法を親切にコード元を教えてください。 現状のマクロ Sub フォルダ移動() Dim alert As VbMsgBoxResult alert = MsgBox("フォルダを移動しますか?", vbYesNo + vbQuestion, "移動確認") If alert <> vbYes Then Exit Sub End If On Error Resume Next Dim fso As Object Dim MSfo As String Dim RSfo As String Dim sh As Worksheet Set sh = Workbooks("作業管理(最新).xlsm").Sheets("物件管理") Set fso = CreateObject("Scripting.FileSystemObject") RSfo = "\\nas-sp01\share\確認部\電子申請 関連\2.審査中\北海\" Dim i As Long For i = 1 To 20 If sh.Cells(i, "AG").Value <> "" Then MSfo = "\\nas-sp01\share\確認部\電子申請 関連\2.審査中\◆未審査物件◆\" & sh.Cells(i, "AG").Value & "_*" End If fso.MoveFolder MSfo, RSfo Next Set fso = Nothing End Sub
質問日時: 2024/11/27 15:06 質問者: エクセル小僧
ベストアンサー
1
0
-
48
Excel マクロについて詳しい方、ご教示ください。 『行数が毎回変わる元データの、A列に「1」と入
Excel マクロについて詳しい方、ご教示ください。 『行数が毎回変わる元データの、A列に「1」と入っている行のみ、先データの各セルにコピペし印刷したい』のですが、うまくいかず行き詰まっています…。 どのようにすればいいでしょうか? ①元データのタイトル行を除きたい ②A列に「1」と入っている場合のみコピペ印刷したい 以上がメインの悩みで、以下はサブ的な悩みなのですが、 ③元データ、先データのセル共に連続していない為、全箇所1個1個指定しているが可能ならコンパクトしたい ④元データシリアル値→先データ元号の数字のみの表記にしたい よろしくお願いいたします。 ーー以下マクローー Sub テスト() Dim lastRow As Long Dim i As Long 'データのA列の最終行取得 lastRow = Sheets("元データ").Range("A" & Rows.Count).End(xlUp).Row '1行目からlastRow行目まで繰り返し For i = 1 To lastRow 'データをセット Sheets("先データ").Range("EA2").Value = Sheets("元データ").Range("B" & i).Value Sheets("先データ").Range("EL2").Value = Sheets("元データ").Range("C" & i).Value Sheets("先データ").Range("EW2").Value = Sheets("元データ").Range("D" & i).Value ※計60箇所ある為省略 '印刷プレビュー Sheets("先データ").PrintPreview Next End Sub
質問日時: 2024/11/23 01:53 質問者: gooddbx1013
ベストアンサー
2
0
-
49
Excelのマクロについて教えてください。
下記のマクロを実行すると指定セル値(CE1)をファイル名にしてマクロ有効ブックとして保存できます。 セル(CE1)には「=$CJ$16&""&$A$2」を設定しており、「CJ$16」には【青紙】と表示しており 「A$2」には物件毎の名前が表示されますが、物件の名前が「No.1」の場合に上手くマクロ有効ブックとして保存できません。(Excelの拡張子が無くなってます) 物件の名前が「№1」の場合には上手くマクロ有効ブックとして保存できます。 これはマクロで解決できるものでしょうか。 教えてください。 現状のマクロ Sub 名前を付けて保存ファイル削除() Dim alert As VbMsgBoxResult alert = MsgBox("名前を付けて保存を行いますか?", vbYesNo + vbQuestion, "保存確認") If alert <> vbYes Then Exit Sub End If On Error Resume Next Dim newName As String newName = Sheets("青紙表").Range("CE1").Value Dim ws As Worksheet Dim TargetCheck As String Dim List As Variant Dim i As Long Dim Chk As Boolean 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 Dim oldName As String oldName = ThisWorkbook.Path & "\" & ThisWorkbook.Name With ThisWorkbook Application.DisplayAlerts = False .SaveAs .Path & "\" & newName, xlOpenXMLWorkbookMacroEnabled Application.DisplayAlerts = True End With Kill oldName Application.ScreenUpdating = True Application.Quit With ThisWorkbook .Saved = True .Close False End With End Sub 以上となります。よろしくお願いいたします。
質問日時: 2024/11/21 10:13 質問者: エクセル小僧
ベストアンサー
2
0
-
50
VBAのエラー表示の対処法について
VBAのコード入力時に 型が一致しません とエラー表示が出てしまいます、、。 対処法がわからず困っています。修正方法を教えていただきたいです。 以下のものが入力したコードです。 よろしくお願いいたします。(´;ω;`) Sub AA1() Dim i For i = 60 To 104 If Cells(i, "D") Like "*入*" Then Range(Cells(i, "AM"), Cells(i, "AP")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i, "D") Like "*退*" Then Range(Cells(i, "AM"), Cells(i, "AL")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i, "D") = "空" Then Range(Cells(i, "AN"), Cells(i, "AL")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i, "D").Interior.Color = RGB(252, 228, 214) And Cells(i, "D") = "" Then '空白でオレンジ色なら Range(Cells(i, "AL"), Cells(i, "AN")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 End If Next i Dim i1 For i1 = 60 To 104 If Cells(i1, "E") Like "*入*" Then Range(Cells(i1, "AS"), Cells(i1, "AP")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i1, "E") Like "*退*" Then Range(Cells(i1, "AM"), Cells(i1, "AP")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i1, "E") = "空" Then Range(Cells(i1, "AO"), Cells(i1, "AQ")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Cells(i1, "E").Interior.Color = RGB(252, 228, 214) And Cells(i1, "E") = "" Then '空白でオレンジ色なら Range(Cells(i1, "A0"), Cells(i1, "AQ")).Interior.Color = RGB(255, 0, 0) ' セルが赤色 End If Next i1 End Sub
質問日時: 2024/11/18 11:59 質問者: ya00623
解決済
6
0
【Visual Basic(VBA)】 に関する回答募集中の質問
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」
「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
-
釣りと密漁の違いは?知らなかったでは済まされない?事前にできることは?
知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
-
カスハラとクレームの違いは?カスハラの法的責任は?企業がとるべき対応は?
東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。 この動きは自治体...
-
なぜ批判コメントをするの?その心理と向き合い方をカウンセラーにきいた!
今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBAでCOPYを繰り返すと、処理が途中...
-
【マクロ】並び替えの範囲が、その...
-
【マクロ】オートフィルター を非表...
-
Vba Array関数について教えてください
-
Vba 型が一致しません(エラー13)...
-
【ExcelVBA】値を変更しながら連続...
-
vbsでのwebフォームへの入力制限?
-
エクセルのマクロについて教えてく...
-
【ExcelVBA】5万行以上のデータ比...
-
VBAでセルの書式を変えずに文字列を...
-
【マクロ】開いているブックの名前...
-
Vba セルの4辺について罫線が有るか...
-
vb.net(vs2022)のtextboxのデザイン...
-
Excel VBA 選択範囲の罫線色の変更...
-
【マクロ】売上一覧YYYYMMDDHHSS.xl...
-
エクセルの改行について
-
VBAで特定の文字が入った行をコピー...
-
WindowsのOutlook を VBA から操作する
-
Excel 範囲指定スクショについて Ex...
-
【マクロ】シートの変数へ入れるコ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Vba セルの4辺について罫線が有るか...
-
vbsでのwebフォームへの入力制限?
-
【ExcelVBA】5万行以上のデータ比...
-
【マクロ】売上一覧YYYYMMDDHHSS.xl...
-
【マクロ】開いているブックの名前...
-
【マクロ】並び替えの範囲が、その...
-
エクセルの改行について
-
エクセルのマクロについて教えてく...
-
vb.net(vs2022)のtextboxのデザイン...
-
VBAでCOPYを繰り返すと、処理が途中...
-
VBA ユーザーフォーム ボタンクリッ...
-
エクセルのVBAコードと数式について...
-
エクセルのVBAコードについて教えて...
-
[VB.net] ボタン(Flat)のEnable時の...
-
【マクロ】変数を使った、文字の種...
-
改行文字「vbCrLf」とは
-
質問58753 このコードでうまく動作...
-
【マクロ】シートの変数へ入れるコ...
-
ワードの図形にマクロを登録できる...
-
算術演算子「¥」の意味について
おすすめ情報