Visual Basic（VBA）

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

回答数

気になる

エクセルの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 呼び出すと，条件付き書式に書き込みはあるようですが，思った動作になりません。該当のSheet１には， 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というセルごとの値をクリップボードにそれぞれ格納するにはどうしたらいいでしょうか？コントロール＋Ｃでコピーをすればクリップボードにそれぞれのセルの値(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
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
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
VBAについて教えて下さい

お世話になります。 excel2019で作成したVBAはexcel2013で動かす事は出来ないのでしょうか？動かない場合はexcel2013とexcel2019に搭載されているマクロや関数の違いよるのでしょうか。対処法などは有りますでしょうか。ご教授宜しくお願い致します。

質問日時: 2024/12/04 00:44 質問者: mokatsu

ベストアンサー

4

0
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
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
Vba 型が一致しません（エラー13）のセルを特定する方法を教えてください

いつもお世話になります今、沢山の数値を扱うプログラムを社内で提供していますが、たまにエラー13が出てその場所特定に呼ばれます。プログラムにパスワードが掛かっているので、解除して再計算で場所を特定しますそこでOnError Gotoからエラーメッセージを出そうと考えましたがその場所が特定できればと思い相談しましたエラーの箇所は単純で Dim ABC as Double の変数に代入するセルに文字が入っているという時ですもし、そのセルの特定方法が分かれば教えてください以上、宜しくお願いいたします

質問日時: 2024/11/29 14:16 質問者: 公共ごま

ベストアンサー

6

0
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\確認部\電子申請　関連\２．審査中\北海\" Dim i As Long For i = 1 To 20 If sh.Cells(i, "AG").Value <> "" Then MSfo = "\\nas-sp01\share\確認部\電子申請　関連\２．審査中\◆未審査物件◆\" & sh.Cells(i, "AG").Value & "_*" End If fso.MoveFolder MSfo, RSfo Next Set fso = Nothing End Sub

質問日時: 2024/11/27 15:06 質問者: エクセル小僧

ベストアンサー

1

0
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
Excel マクロについて詳しい方、ご教示ください。『行数が毎回変わる元データの、A列に「1」と入

Excel マクロについて詳しい方、ご教示ください。『行数が毎回変わる元データの、A列に「1」と入っている行のみ、先データの各セルにコピペし印刷したい』のですが、うまくいかず行き詰まっています…。どのようにすればいいでしょうか？ ①元データのタイトル行を除きたい ②A列に「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
VBAで特定の文字が入った行をコピーして貼り付けたい

仕事で他の人に使ってもらうExcelファイルを作っているのですが行き詰っているので助けてください。 ①列指定して特定の文字が入ったセルを複数条件から探して該当する行を全てコピーして、 ②空いている行から貼り付けして、 ③コピーした行のセルの一か所（ I列予定）に文字や記号を1文字追加したい。 Sub 行コピー() Dim mySheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long Set mySheet = ThisWorkbook.Sheets("シート名") Set targetSheet = ThisWorkbook.Sheets("シート名") lastRow = mySheet.Cells(mySheet.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow If mySheet.Cells(i, "E").Value = "〇〇" Or mySheet.Cells(i, "E").Value = "△△" Or mySheet.Cells(i, "E").Value = "✕✕" Then mySheet.Rows(i).Copy Destination:=targetSheet.Rows(targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1) End If Next i End Sub ネットで探して②までは上記で可能なのですが③が分からず、どなたか助けて頂けると助かります。

質問日時: 2024/11/22 15:50 質問者: マーボー666

ベストアンサー

2

0
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
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
Excelのマクロについて教えてください。

下記のマクロはネットから参照したマクロで、マクロを実行すると指定フォルダが圧縮できます。このマクロでが圧縮対象のフォルダを targetPath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用" '作成するZIPファイルのパスを zipFilePath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用.zip" に指定しておりますが、この指定をマクロ設定ブックと同じフォルダ内にある、フォルダ「12345678-5_交付用」に変更出来る方法を教えてください。尚、圧縮対象フォルダは1つしか無く、「_交付用」は固定フォルダ名になりますが、「_交付用」から前の部分（12345678-5）は物件毎に変更になる為、 ' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合 If folderName Like "########-#_交付用" Then のような設定を希望いたします。現状のマクロ Sub フォルダを圧縮() Dim targetPath As String Dim zipFilePath As String Dim psCommand As String Dim wsh As Object Dim result As Integer 'ZIP形式で圧縮するフォルダ(またはファイル)パスを指定 targetPath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用" '作成するZIPファイルのパスを指定 zipFilePath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用.zip" '実行するPowerShellのコマンドレットを組み立て psCommand = "powershell -NoProfile -ExecutionPolicy Unrestricted Compress-Archive -Path " & targetPath & " -DestinationPath " & zipFilePath & " -Force" Set wsh = CreateObject("WScript.Shell") 'PowerShellのコマンドレットを実行 result = wsh.Run(Command:=psCommand, WindowStyle:=0, WaitOnReturn:=True) If (result = 0) Then MsgBox ("圧縮が正常終了しました。") Else MsgBox ("圧縮が異常終了しました。") End If '後片付け Set wsh = Nothing End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/11/18 09:09 質問者: エクセル小僧

ベストアンサー

1

0
VBAのループ処理について教えてください

Sub　AA（） If Range("D60") Like "*入*" Then Range("AM60:AP60").Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Range("D60") Like "*退*" Then Range("AL60:AM60").Interior.Color = RGB(255, 0, 0) ' セルが赤色 ElseIf Range("D60") = "空" Then Range("AL60:AN60").Interior.Color = RGB(255, 0, 0) ' セルが赤色 End If 　Eｎｄ　Sub 上記の式はシートの６０行目についての処理ですが、これを１０２行目まで同列で同じ処理をしたい場合のループ処理の記載方法を教えて頂きたいです。。。よろしくお願いいたします。

質問日時: 2024/11/15 11:47 質問者: ya00623

ベストアンサー

3

0
修正依頼：【VBA】結合セルに複数画像とファイル名一括挿入する方法

ご覧いただきありがとうございます。以前、「ダイアログボックスを開き画像ファイルを選択、１行目が見出し行になっている表のB2から６行ごとに結合したセルに画像を挿入し、隣のC列(６行ごと結合)に画像ファイル名(拡張子なし)が入る表を作る」という件で以下のコードを作成していただいたのですが、画像がリンク貼り付けになってしまい、メール等で送信すると見れなくなってしまいます。リンクではなく画像として挿入するためにはどうしたらいいでしょうか？詳しい方、よろしくお願いいたします。 Sub Sample() Dim i As Long, fileName As String Dim rng As Range, sItems With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Image Files" .Filters.Clear .Filters.Add "Image Files", "*.GIF; *.JPG; *.BMP; *.PNG; *.TIF", 1 .AllowMultiSelect = True If .Show = 0 Then Exit Sub Set sItems = .SelectedItems End With For i = 1 To sItems.Count fileName = Dir(sItems(i)) Set rng = Cells(i * 6 - 4, 2) rng.Offset(, 1).Value = Left(fileName, InStrRev(fileName, ".") - 1) Set rng = rng.MergeArea With ActiveSheet.Pictures.Insert(sItems(i)) .Left = rng.Left .Top = rng.Top .Placement = xlMoveAndSize .ShapeRange.LockAspectRatio = msoFalse .ShapeRange.Width = rng.Width .ShapeRange.Height = rng.Height End With Next i End Sub

質問日時: 2024/11/14 16:46 質問者: ukr-pm

ベストアンサー

2

1
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
Excelのマクロについて教えてください。

下記のマクロは先日教えて頂いたマクロで、マクロを実行するとフォルダ：検査時必要図書（正本）の中にある、PDFファイルをフォルダ：########-#_交付用にコピーできます。このコードをフォルダ：検査時必要図書（正本）を無くしてマクロ設定ブックと同じフォルダ内にあるPDFファイルをマクロ設定ブックと同じフォルダ内にあるフォルダ：########-#_交付用に移動出来る方法を教えてください。（親切に詳しいコード共教えてください）宜しくお願い致します。現状のマクロ Sub 交付用に移動() 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 <> "" ' ファイルのコピーを実行 FileCopy myPath(1) & fname, 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") ' 検査時必要図書（正本）フォルダの取得 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/11/13 14:05 質問者: エクセル小僧

ベストアンサー

2

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

下記のマクロを以下の条件のように変更出来る方法を教えてください。マクロを実行するとワイルドカード名のPDFファイルが指定フォルダから指定フォルダ内にコピーされます。コードの「Case "検査時必要図書（正本）"」ですが、マクロを設定しているフォルダを指定（仮に今回はフォルダを「テスト部件」としてます。コードの「Case "返却用（副本）"」ですがマクロを設定しているフォルダ内のフォルダを指定（今回は：24110955-1_交付用となっておりますが、最初「_」前の半角英数字と8文字と「-」以下の半角英数字と1文字は物件によって変更されますが、「_交付用」は変更されません。画像のようにテスト物件フォルダ内にある「24001234-1_（仮称）北海太郎（交付用_A3）.pdf」を同じくテスト部件内にあるフォルダ名「24001234-1_交付用」内にコピーを出来る方法を教えてください。できるだけ詳しいコード迄、親切に教えてください。現状のマクロ Sub 交付用() On Error Resume Next Dim myPath As Variant Dim fPath As String, fname As String fPath = ThisWorkbook.Path fPath = Left(fPath, InStrRev(fPath, "\") - 1) myPath = folder_acquisition(fPath) fname = Dir(myPath(1) & "*（交付用_A3）.pdf") Do While fname <> "" FileCopy myPath(1) & fname, 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") With fso For Each f In .GetFolder(fPath).SubFolders Select Case Mid(f.Path, InStrRev(f.Path, "\") + 1) Case "検査時必要図書（正本）" myPath(1) = f.Path & "\" n = n + 1 Case "返却用（副本）" myPath(2) = f.Path & "\" n = n + 1 End Select If n = 2 Then Exit For Next f End With Set fso = Nothing folder_acquisition = myPath() End Function 以上となります。

質問日時: 2024/11/08 15:17 質問者: エクセル小僧

ベストアンサー

1

0
Visualbasicの現状について教えてください

いつもお世話になります最近はVBAでプログラムを7，8年開発してきましたが、解析業務でのデータ入力に関して対話式の入力プログラムおよび図化プログラムを作る必要性が出てきました現在は昔に買ったVisual Studio2010が有るのですが現状のVisualBasicを揃えようとしてインターネットを調べたらいろいろバージョンが有り、VisualBasicのことはあまり書かれていません古い人間なのでVisualBasicだけあれば良いのですがどれをチョイスしたらよいのか迷っています何か薦める製品が有りましたら教えてください居樹王、宜しくお願い申し上げます

質問日時: 2024/11/06 16:43 質問者: 公共ごま

ベストアンサー

4

0
VBA 2次元配列の出力

EXCEL Microsoft365 VBAで、2行、179997列の2次元配列があります。 1行目には時刻、2行目には数値データがはいっています。この配列について、A1セルをリサイズ、行列変換して出力することで、 A列に時刻、B列に数値データの一覧がほしいです。しかし、出力すると、48926行目で、次の行以降が勝手にB列に折り返されて出力されてしまいます。配列には正しくデータが入っていることを確認しているのですが、出力する際に、特定の行以降が次の行に出力されてしまい、 A列とB列に時刻が出力されてしまい、数値データが出力されません。なお、48926行から179997行までは#N/Aとなっています。データ数を少なくした場合(2行10列)で実行したときには問題なく出力されましたので、コード上に問題はないと思っています。

質問日時: 2024/10/26 17:22 質問者: ぶつりがくっておいしいの

ベストアンサー

1

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

下記のマクロを実行すると、指定セル値がファイル名となり、保存され、マクロ設定ブックが、削除されます。このマクロを下記の様に変更する方法を教えてください。シート名「新料金算定表2024.05」の指定セル「AS2」に（確認）と表示された場合のみこのマクロが実行でき。シート名「新料金算定表2024.05」の指定セル「AS2」に（確認）と表示されていない場合は、メッセージボックスで（料金表を確認後、保存してください）とメッセージが表示され、マクロを実行する事が出来ないように出来る方法を教えてください。現状のマクロ 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("B54").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/10/24 09:27 質問者: エクセル小僧

ベストアンサー

2

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

マクロ設定ブックにシート名「受付」「青紙表」「1」と「審査」があります。作業の流れで、シート名「1」を表示して、作業を行う必要がありますが度々失念してしまう事があり、マクロ等を設定し、この失念を防止したいと考えております。私の希望ですが、シート名「1」を1回でも表示しないと、シート名「審査」のシートに移動できないように設定できるマクロを教えてください。その時にメッセージボックスが表示され、（シート「1」の作業が完了しておりません。作業を完了してください。）と表示出来る方法もお願いいたします。又、このVBAコードをどこのシートに設定又はThisWorkbook を含めて親切にコード共教えください。宜しくお願い致します。

質問日時: 2024/10/23 11:58 質問者: エクセル小僧

ベストアンサー

2

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

下記のマクロは以前教えて頂いたマクロで、このマクロを実行するとダイアログが開き指定したPDFファイルを指定セル値にてファイル名が変更され、マクロ設定ブックと同じフォルダ内に保存されます。ファイル名を変更したファイルの保存先をマクロ設定ブックと同じフォルダ内では無く変更したいファイル名を変更したい「PDFファイル」があるフォルダ内にそのまま指定セル値でのファイル名に変更して保存できる方法を教えてください。現状のマクロ Sub 行政回答修正あり() Dim TargetFile As String Dim fPath As String, fname As String Dim newfName As String newfName = ThisWorkbook.Sheets("Webコメント").Range("V1").Value & ".pdf" newfName = NGNarrowToWide(newfName) ''メッセージを表示し、実施確認する。 If MsgBox(newfName & vbCrLf & vbCrLf & "行政回答（修正あり）を作成しますか。", 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/10/22 09:41 質問者: エクセル小僧

ベストアンサー

2

0
WindowsのOutlook を VBA から操作する

取引の為余計なソフトを入れなかった為、officeのOutlookを入れようとしたら、WindowsのOutlookが入ってしまい、普通に使えるのですが、VBAから操作できず困っています。 WindowsのOutlook Microsoft Outlook バージョンがインストールされています1.2024.1009.100 (Production). クライアントバージョンは以下の通りです:20241011003.11. WebView2 バージョンは 129.0.2792.89. セッション ID は 6ae48727-7623-7640-8eb7-24548d6cf6cf.= officeのOutlook　の使い方は下記の通りです。一番簡単な方法かと・・・（当方はこれで十分なのですが） 'Outlookオブジェクトの変数宣言 Dim outlookObj As Outlook.Application Set outlookObj = New Outlook.Application 'メール送信用のオブジェクト作成 Dim mailObj As Outlook.MailItem Set mailObj = outlookObj.CreateItem(olMailItem) With mailObj '' .To = "xxxxxxxxxxxxx@xxxxx.xxx" 'メール宛先 '' .Subject = "メールの件名" 'メール件名 '' .body = "メール本文" 'メール本文 '' .BodyFormat = olFormatPlain 'メール形式に設定 End With .send WindowsのOutlookの　ブジェクトの変数宣言　と　メール送信用のオブジェクト作成　などをお教え願えれば幸いです。参考URL　でも結構です。

質問日時: 2024/10/19 17:52 質問者: kozo2004

ベストアンサー

4

0
エクセルのVBAコードについて教えてください。

作業ブックの「ThisWorkbook」に下記のコードを設定しております。このコードは「昇降機【青紙】（表面）」の指定セル「R20」に不特定の文字が表示されないと、警告文が表示され「昇降機質疑」シートに移動できないように設定したコードです。このコードを指定セル「R20」に不特定の文字では無く不特定の半角英数字（8文字）が表示されないとシート移動が出来ないように変更出来る方法を教えてください。現状のコード Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) If ActiveSheet.Name <> "昇降機質疑" Then Exit Sub Dim ws As Worksheet: Set ws = Worksheets("昇降機【青紙】（表面）") Dim c As Range If Not c Is Nothing Or IsEmpty(ws.Range("R20")) Or IsNumeric(ws.Range("R20")) Then MsgBox "未入力セルがあります、入力しないとシートを移動できません", vbCritical Application.EnableEvents = False Sh.Select Application.EnableEvents = True End If End Sub 以上となります。宜しくお願い致します

質問日時: 2024/10/16 15:52 質問者: エクセル小僧

ベストアンサー

1

0
エクセルvbaの対象セルに色をつける例えば a日付 b種類 c値段 dその他にんじん 50 ぴー

エクセルvbaの対象セルに色をつける例えば a日付 b種類 c値段 dその他　　　　　　にんじん　　　50 　　　　　　ぴーまん 100 　　　　　　にんにく 250 ピーマン 150 みたいな表があって［やりたい事］ B列の種類にピーマン、C列に100円があれば AからD列セルを黄色に B列がピーマン　C列が150円は赤色にしたい場合はどうすればいいですか？自分なりに調べたらB列:B列で［ピーマン］の場所を検索して(dir)色をつけるみたいなことが書いてありましたがよく意味がわかりませんでした

質問日時: 2024/10/15 14:33 質問者: pico1234567

ベストアンサー

1

1
エクセルVBAのブックを開く方法例えば［20241001］［20241002］［202410

エクセルVBAのブックを開く方法例えば［20241001］［20241002］［20241003］のように毎日フォルダーが出来てきまして、各フォルダの中にはその日のデータが入ったデータA.csv データB.csv データC.csvの3つのcsvが入ってます。マクロが入ったブックを日毎にフォルダーに入れて、そのフォルダー内のcsvを開き、名前をつけてエクセルブックで保存したいのですがどうしたらいいですか？困っている事毎日フォルダが変わるのでパスでは出来ないです。出来ればデータ名は毎回同じなので、［フォルダー内のデータA.csv］を開くという設定にして、名前で拾いたい。また保存も同じファイル内にしたいですブック［マクロ］→ファイル内のcsvを名前で開く→名前をつけてエクセルデータで同じフォルダ内に保存

質問日時: 2024/10/11 22:13 質問者: pico1234567

ベストアンサー

3

0
エクセルVBAで特定のセルの値をコメントに置き換えることについて A1のセルに入っている値(文字)を

エクセルVBAで特定のセルの値をコメントに置き換えることについて A1のセルに入っている値(文字)を、別のシートのB1セルのコメントに貼り付けたいです。 A1の値は毎回変わるので、マクロボタンを押すたびにA1の値を別シートB1のコメントに貼り付けるにはどうしたらいいですか？別シートのB1のコメント欄を出す事と常に表示させる所までは出来ました。A1の値を空欄のコメントに貼り付けたいです ※何度か頑張ってみたのですが出来ず困っています。

質問日時: 2024/10/11 20:00 質問者: pico1234567

ベストアンサー

3

0
エクセルでCDOを使ったメール送信について

お世話になります。いつも助けていただいております。エクセルでメール送信で，CDOを使ったものをしりました。使ってるサーバーがサクラなので，下記を参考に， https://qiita.com/apple123/items/c2cf2204d1992c5129e5 自分の環境にしてみましたが，全く反応がありません。そのほか，gmail，yahoo，等の環境でもためしてみてもだめでした。 2024年現在，CDOを使って，メールを送信できている方いらっしゃるのでしょうか。もしいたら，アドバイスいただければありがたいです。よろしくお願いいたします。

質問日時: 2024/10/10 10:10 質問者: mabo52

ベストアンサー

1

1
【ExcelVBA】dictionaryの重複判断の基準（セル結合だと違う値として認識される）

重複データを抽出したく試していますが、以下で詰まっています。例えば、 A、B、C列のデータを連結したものを比較対象とし、複数行あるものから重複データを抽出したいのですが、「＆」で繋げたものを比較すると、違うものとみなされます。 A1、B１、C1を連結したものを１１１（A1に１、B１に１、C1に１）とし、 A２、B２、C２を連結したものを１１１（A２に１、B２に１、C２に１）とした場合、 dictionaryを使って、重複データを抽出している途中ですが、「１１１」と「１１１」が違うものとして判断されてしまいますが、同じだからエラー（既に割り当てられてる）で止まります（結合しなければ、機能します）。一旦シート上で結合したものを値貼り付けに変えて、それをチェック対象にするしかないでしょうか？データは数万行あります。ご存知の方、ご教示お願いします。＜以下コード（コードは自分で考えたものではなく一部流用で、抽出できたら整形します）＞ 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
【ExcelVBA】５万行以上のデータ比較の効率的な処理方法について

社内での重複チェックツールを作っています。セル関数で対応していましたが、以下理由でマクロでないと厳しいため試行錯誤中です。・行数は不定で、使うときに足りない分を関数を付け足す作業はしたくない・関数を埋め込んだ場合、ファイルサイズが大きすぎて開かない＆再計算でフリーズ・マクロにしたはいいが、結果が遅い（量が量だから仕方ない？）以下処理ですが、スピードが今一歩と感じています。アドバイス頂ければ、幸いです。データは現状５万ちょっとが最大です。基本配列を使って比較すればいいのですが、デバッグしてると２０秒位かかり、ハングアップしてるか不安になり、escすると止まるので動いてはいますが、量が多いからこんなもんでしょうか？やりたいことは１つずつ比較して、２つ以上ある箇所の隣に×をして更に隣のセルに該当データを出力させます。そして、フィルターを掛けて抽出できるようにします。これをボタンを押したら、ファイルを選ばせてチェックが始まるという流れです。以下試しのコードです（比較箇所だけ） sub test Set targetRng = Range("A1:a50000") For Each Rng In targetRng For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Rng = Cells(i, 1) Then cnt1 = cnt1 + 1 End If Next If cnt1 > 1 Then Rng.Offset(0, 1) = "×" End If cnt1 = 0 Next end test

質問日時: 2024/10/06 21:13 質問者: yoshikadu

ベストアンサー

7

1
VBAでセルの書式を変えずに文字列を置換する方法をご教示ください

大変お世話になっております。 VBAの超初心者です。皆さまどうかご教示ください。 Excelで資料を作っていて、下記、洋ちゃんさん（Know-How-No-Life）のマクロを応用して、セルの書式を変えずに文字を置換したいと思っています。 https://www.banana-juice.com/tech/articles/replace-without-format 資料の体裁は以下の画像のような形です。この中でURLは青色、日付の類（20200808だけでなく、申請日(yyyy/mm/dd)も赤く表示）が赤色で表示されているとします。 https://kaizen-penguin.com/wp-content/uploads/2020/08/image-768x395.png 置き換える文字列は申請日(yyyy/mm/dd)を申請日(2024/08/08)にしたいと考えています。洋ちゃんさん（Know-How-No-Life）のhttps://www.banana-juice.com/tech/articles/replace-without-formatにあるマクロを利用する場合、どこをどのように変更すればいいでしょうか。また実行する場合は、「Call 書式を保持したままReplace("申請日(yyyy/mm/dd)", "申請日(2024/08/08)")」とすればいいのでしょうか。ご教示の程どうぞよろしくお願いいたします。

質問日時: 2024/10/04 22:19 質問者: ナカシュン太郎

ベストアンサー

1

1
【VBA】結合セルに複数画像とファイル名一括挿入する方法

ご覧いただきありがとうございます。 VBA初心者です。ダイアログボックスを開き画像ファイルを選択、１行目が見出し行になっている表のB2から６行ごとに結合したセルに画像を挿入し、隣のC列(６行ごと結合)に画像ファイル名(拡張子なし)が入る表を作りたいです。結合していないセルの場合、以下のコードで作成できました。６行ごとに結合したセルの場合は、どのように修正したらいいのでしょうか？詳しい方、よろしくお願いいたします。 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

←前の結果
1
2
3
4
5
6
7
8
9
10
11
...
20
次の結果→

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

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

質問する（無料）

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

カスハラとクレームの違いは？カスハラの法的責任は？企業がとるべき対応は？

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

今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
大麻の使用罪がなかった理由や法改正での変更点、他国との違いを弁護士が解説

ドイツで2024年4月に大麻が合法化され、その2ヶ月後にサッカーEURO2024が行われた。その際、ドイツ警察は大会運営における治安維持の一つの方針として「アルコールを飲んでいるグループと、大麻を吸っているグループ...
ピンとくる人とこない人の違いは？直感を鍛える方法を心理コンサルタントに聞いた！

根拠はないがなんとなくそう感じる……。そんな「直感がした」という経験がある人は少なくないだろう。ただ直感は目には見えず、具体的な説明が難しいこともあるため、その正体は理解しにくい。「教えて！goo」にも「...