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

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

回答数

気になる

エクセル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
[Excel VBA]特定の条件で文字を削除＆残す処理をするファイルを作成したいです

助けてください。 Excelは関数を少し使ってるくらいのVB全くわかってないレベルで恐縮なのですが仕事で以下のファイルを作る必要があり検索などで色々調べているものの見事につまづいております。作りたいファイルは、添付画像のように列Fの結合セルにはテキストで　"あいうえお"　がそれぞれ入っているのですがメモ下の結合セル内が〇の時は列F4の結合セル、あいうえお（赤字）を削除して空白に。 ×の時は列F11の結合セル、あいうえお（青字）はそのまま残す。のようなマクロを組みたいです。 if分を使えば、、というイメージはありますが、型の指定など諸々ちんぷんかんぷんでどのようにすればよいか苦慮しております。可能であればコードをそのまま貼り付けられる状態で教えていただけると嬉しいです。よろしくお願いいたします。

質問日時: 2024/09/30 12:09 質問者: モノルル

ベストアンサー

4

0
【VBA】値を変更しながら連続でPDFを作成し，それらに印刷設定をした状態で結合するコード

office365を使っている者です。以前，この掲示板でExcel VBAで連続でPDFを作製し，それらを結合した状態でPDFで出力するコードを以下のとおり教えていただいた者です。結合する前のデータ１件につき１ページでPDFが作成されるように設定を加えたいと思い，質問させていただきます。 -------------------------------------------------------------- Sub 連続PDF作成() Dim stK, stY, stD Dim startN, endN, i As Long Const AA = "A1:H40" ' ← コピー(転記)対象のセル範囲 Const fileName = "hoge" ' ← 作成するPDFファイル名 Set stK = Worksheets("回答") Set stY = Worksheets("様式") startN = stK.Range("I2").Value endN = stK.Range("I3").Value If Application.CountBlank(stK.Range("I2:I3")) > 0 Or _ Not (IsNumeric(startN) And IsNumeric(endN)) Then _ MsgBox "無効な入力です": Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False stY.Copy With ActiveWorkbook Set stD = ActiveSheet For i = startN To endN stK.Range("A5").Value = stK.Cells(i + 9, 1).Value stD.Copy after:=.Worksheets(.Worksheets.Count) .Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value Next i stD.Delete .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & fileName .Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub ------------------------------------------------------------------------ 「様式」シートの内容を新しいシートとしてコピーして，値だけにして，それを順番に結合していくという内容になっています。「様式」シート１件のデータ（変数 i でコントロールしています）につき１ページでPDFを作成したいのですが，上のコードだと端末の環境によっては２ページになってしまうことがあります。そこで，以下のようにPageSetupのコードを「stD.Copy after:=.Worksheets(.Worksheets.Count) .Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value」と「Next i」の間に入れてみたのですが，デバックで止まってしまいます。（実行時エラー「438」です）どのようにすれば，問題なく動くようになるのかご教示願います。 --------------------------------------------------------------------- .Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value .Worksheets(.Worksheets.Count).PageSetup .Worksheets(.Worksheets.Count).Zoom = False '拡大/縮小の指定を無しにする .Worksheets(.Worksheets.Count).FitToPagesWide = 1 '1ページに収める（横） .Worksheets(.Worksheets.Count).FitToPagesTall = 1 '1ページに収める（縦） .Worksheets(.Worksheets.Count).CenterHorizontally = True '真ん中に配置（横） .Worksheets(.Worksheets.Count).CenterVertically = True '真ん中に配置（縦） Next i --------------------------------------------------------------------------

質問日時: 2024/09/26 15:34 質問者: qazxcvfr4

ベストアンサー

1

0
エクセルタブの下のメニューを選択実行するコード

エクセルのタブを選択するところまでは出来ました。参照URL https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=1267#google_vignette これは　３２Bit　適宜　６４に変更する必要ありタブの下（そも、タブの下・これは何と呼ぶのか？　一応メニューと言うはず・・・）　メニューの　左から２番目を　実行させたいここにたどり着いたのですが https://liclog.net/menu-operation-rpa-function-vba-api/#google_vignette いまいち、こちらの能力不足でエクセル　開発　VBA　起動で　結構ですので実行コード　もしくは　上記のページについて解説願えれば幸いです。

質問日時: 2024/09/24 20:16 質問者: kozo2004

解決済

1

1
Web画面の文字をVB6で取得したい

VB6でWebブラウザを使わず（つまりIE.Navigateをぜず）に、 Web画面の文字を取得したいのですが、どのようなコードを書けばよいでしょうか。ひとまずxmlHTTP オブジェクトをクリエイトしての文字列取得には成功したのですが、こちらは xmlHTTP.Open "GET", "取得したいＵＲＬ" と言う命令の方法になっており、この方法だと、Web画面の一部の文字をクリックすることで、別画面としてポップアップされる子画面の文字は取得が無理そうでした。それは子画面が、"取得したいＵＲＬ"ではなく別ものになるからです。では子画面のＵＲＬはわかるので Open "GET", "子画面のＵＲＬ" とするといけそうですが、親画面から起動した子画面でないと、命令を認識しないと言う制約があるようでした。別な表現をしますと、欲しい文字が子画面の文字なのですが、別のＵＲＬとなっている為に取得できず、では、 xmlHTTP.Open "GET", "子画面のＵＲＬ" としても、親画面から何かを継続して表示したものでなければ、取得できない構造でした。これはVB6のインターネットコントロールを使っても同様です。 Web画面のタイトル部分ならば、 GetWindowTextと言うAPI関数で取得できたのですが、メイン画面から別に起動する子画面の全ての文字取得は、実装ができませんでした。実装できる関数に心当たりはありませんか？かくなる上はセンドキーで、Ctrl+A と Ctrl+C を送るのですが、常にターゲットの画面にフォーカスを与えなくてはならず、他のアプリの画面が使えなくなってしまいます。ＶＢドットネットであればこれらは解決できるでしょうか。ドットネットを使ってもメインのＵＲＬ画面から別ＵＲＬで開く、子画面の文字列取得は難しいように思っています。取得のためのAPI関数が分かれば一番良いのですが、アドバイスの程、よろしくお願いします。

質問日時: 2024/09/20 11:18 質問者: VT250F

ベストアンサー

3

1
ＶBA 入力箇所指定方法

はじめまして。やりたい事は、A1にQRコードを読み後、自動でB1に移動しまたQRコードを読み後 A2列に移動、QRコードを読み後、自動でB2に移動しまたQRコードを読み後A3に移動の繰り返しをプロブラミングしたいのですがよくわかりません。御存じの方ご教授お願い致します。

質問日時: 2024/09/14 07:00 質問者: たけやん224

解決済

2

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

下記のマクロを実行すると、確認メッセージが表示され「YES」をクリックするとマクロ設定ブックと同じフォルダ内にある指定の圧縮ファイルを削除できます。このコードを変更してマクロ設定ブックと同じフォルダ内に既に圧縮ファイルが削除されて無い場合にマクロを実行した時に確認メッセージが表示されない方法を教えてください。現状のマクロ Sub 削除() Dim alert As VbMsgBoxResult alert = MsgBox("圧縮ファイルを削除してよろしいですか？", vbYesNo + vbQuestion, "削除確認") If alert <> vbYes Then Exit Sub End If On Error Resume Next Kill ThisWorkbook.Path & "\*.zip" Kill ThisWorkbook.Path & "\*.7z" End Sub 以上となります。よろしくお願いいたします。

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

ベストアンサー

4

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

下記のマクロは先ほど教えて頂いたマクロでコピー元の指定シートとセル値をコピー先にコピペできます。 Sub Macro1() Call 採光シートコピー範囲 Call 貼り付け Call 採光データ削除 End Sub 張り付けた後にコピー元のファイルが不要の為、マクロ「採光データ削除」を実行して、ファイルを削除したいのですが、削除対象のファイルが開いた状態なので、エラーメッセージが出て、ファイルを削除できません。以前教えて頂いたコードをそのまま利用しており、コピー元のファイルのコピー範囲が完了するとこのファイルは閉じると思うのですが、なぜか、開いたままの状態です。それぞれのマクロを書き込みますので、解決方法を教えてください。 Sub 採光シートコピー範囲() Dim folderPath As String Dim fileName As String Dim ws As Worksheet folderPath = ThisWorkbook.Path & "\" '作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の ' 採光計算確認.xlsxの 2つのExcelファイルしかありません｡ fileName = Dir(folderPath & "*.xlsx?") Do While fileName <> "" If CheckName(fileName) = True Then Exit Do fileName = Dir() Loop If fileName <> "" Then '別ブック採光計算書.xlsx Set Wb2 = Workbooks.Open(folderPath & fileName) On Error Resume Next Set ws = Wb2.Worksheets("Table 2") If Err.Number <> 0 Then MsgBox "コピー元ブックの提出シートが見つかりません" On Error GoTo 0 Wb2.Close False End End If 'セルの値を取得する ws.Range("A1:W51").Copy On Error GoTo 0 ws.Activate ws.Range("A1:W51").Copy Else MsgBox "コピー元ブックが見つかりません": End End If End Sub Private Function CheckName(ByVal fileName As String) As Boolean CheckName = False If fileName = ThisWorkbook.Name Then Exit Function CheckName = True If LCase(Right(fileName, 5)) = ".xlsx" Then Exit Function If LCase(Right(fileName, 5)) = ".xlsm" Then Exit Function CheckName = False End Function Sub 貼り付け() Dim ws1 As Worksheet Set Wb1 = Workbooks(1) 'このブック On Error Resume Next Set ws1 = Wb1.Worksheets("採光確認") If Err.Number <> 0 Then MsgBox "コピー先ブックの受付シートが見つかりません" Application.CutCopyMode = False On Error GoTo 0 If Not Wb2 Is Nothing Then Wb2.Close False End End If Application.DisplayAlerts = False Application.EnableEvents = False ws1.Range("A1:W52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Application.EnableEvents = True Application.DisplayAlerts = True End Sub Sub 採光データ削除() Dim filePath As String filePath = ThisWorkbook.Path & "\採光計算書.xlsx" If Dir(filePath) <> "" Then Kill filePath End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/09/12 12:10 質問者: エクセル小僧

ベストアンサー

6

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

下記のマクロを実行するとコピー元のシートの指定セル範囲を、コピー元（マクロ設定ブック）にコピーできます。コピー元のシートが「Table 1」「Table 2」「Table 3」が3つありシートを「Table 2」と指定しているのですが、上手くコピペできません、コピー元のシート「Table 1」と「Table 3」をあらかじめ削除し、「Table 2」のみの状態で、マクロを実行すると、上手く行きます。出来ればコピー元のシートが「Table 1」「Table 2」「Table 3」3つある状態で上手くコピペ出来る方法を教えてください。現状のマクロです。 Sub Macro1() Call 採光シートコピー範囲 Call 貼り付け End Sub Sub 採光シートコピー範囲() Dim folderPath As String Dim fileName As String Dim ws As Worksheet folderPath = ThisWorkbook.Path & "\" '作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の ' 採光計算確認.xlsxの 2つのExcelファイルしかありません｡ fileName = Dir(folderPath & "*.xlsx?") Do While fileName <> "" If CheckName(fileName) = True Then Exit Do fileName = Dir() Loop If fileName <> "" Then '別ブック採光計算書.xlsx Set Wb2 = Workbooks.Open(folderPath & fileName) On Error Resume Next Set ws = Wb2.Worksheets("Table 2") If Err.Number <> 0 Then MsgBox "コピー元ブックの提出シートが見つかりません" On Error GoTo 0 Wb2.Close False End End If 'セルの値を取得する ws.Range("A1:W51").Copy Else MsgBox "コピー元ブックが見つかりません": End End If End Sub Private Function CheckName(ByVal fileName As String) As Boolean CheckName = False If fileName = ThisWorkbook.Name Then Exit Function CheckName = True If LCase(Right(fileName, 5)) = ".xlsx" Then Exit Function If LCase(Right(fileName, 5)) = ".xlsm" Then Exit Function CheckName = False End Function Sub 貼り付け() Dim ws1 As Worksheet Set Wb1 = Workbooks(1) 'このブック On Error Resume Next Set ws1 = Wb1.Worksheets("採光確認") If Err.Number <> 0 Then MsgBox "コピー先ブックの受付シートが見つかりません" Application.CutCopyMode = False On Error GoTo 0 If Not Wb2 Is Nothing Then Wb2.Close False End End If Application.DisplayAlerts = False Application.EnableEvents = False ws1.Range("A1:W52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Application.EnableEvents = True Application.DisplayAlerts = True End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/09/12 10:09 質問者: エクセル小僧

ベストアンサー

1

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

下記のマクロを実行すると、指定フォルダ内の指定ファイルが削除できます。この指定フォルダをマクロを設定しているフォルダ内に削除ファイルがある時に指定ファイルを削除出来る方法を教えてください。 ilePath = "\\nas-sp01\share\確認部\電子申請関連\２．審査中\北海\採光確認\採光計算書.pdf" このコードをマクロ設定ブックと同じフォルダ内に削除ファイルがある場合に指定ファイルを削除したいです。現状のマクロ Sub PDFファイル削除() Dim filePath As String filePath = "\\nas-sp01\share\確認部\電子申請関連\２．審査中\北海\採光確認\採光計算書.pdf" If Dir(filePath) <> "" Then Kill filePath End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/09/12 09:32 質問者: エクセル小僧

ベストアンサー

2

0
EXCEL vbaでシート上に配置したボタンの移動については

シート上に配置したボタンが、マウスでスクロールすると画面と共に移動し、画面表示から外れてしまいます。この状態を、マウスで行を多く送ってもボタンは常に画面上の同じ位置にあるようにしたいのです。コントロールの書式設定のプロパティのチェック変更では対応出来ないようです。どなたかご存知の方、対処法をご教授ぐださいませ。よろしくお願いします。

質問日時: 2024/09/11 23:16 質問者: take913

ベストアンサー

2

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

下記マクロは先ほど教えて頂いたマクロを少し変更して指定セル値の合計をそれぞれセル「Y8＝B4、E4・Y14＝B10、E10・Y20＝B16、E16中間省略Y116＝B112、E112・Y122＝B118、E118」に表示出来るようにしましたが、マクロを実行すると上記の全てのセルに Y8の計算結果が表示されてしまいます。解決方法を教えてください。現状のマクロ Sub Macro1() Dim i As Long Dim r As Long Dim str1 As String Dim str2 As String Sheets("Table 2").Select For i = 1 To 20 r = i * 6 + 2 str1 = "$Y$" & r str2 = "=IFERROR(ROUND(SUMPRODUCT(--TEXTSPLIT($B$4,,CHAR(10)),--TEXTSPLIT($E$4,,CHAR(10))),2),"""")" Range(str1) = str2 Next End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/09/10 13:14 質問者: エクセル小僧

ベストアンサー

3

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

下記マクロを短いコード（一つのコード）に変更する方法を教えてください。 Sub 採光面積() Sheets("Table 2").Select Range("$AC$8").Formula = "=IFERROR(ROUNDUP($Y$8*数式! $C$1,2),"""")" Range("$AC$14").Formula = "=IFERROR(round($Y$14*数式! $C$2,2),"""")" Range("$AC$20").Formula = "=IFERROR(round($Y$20*数式! $C$3,2),"""")" Range("$AC$26").Formula = "=IFERROR(round($Y$26*数式! $C$4,2),"""")" Range("$AC$32").Formula = "=IFERROR(round($Y$32*数式! $C$5,2),"""")" Range("$AC$38").Formula = "=IFERROR(round($Y$38*数式! $C$6,2),"""")" Range("$AC$44").Formula = "=IFERROR(round($Y$44*数式! $C$7,2),"""")" Range("$AC$50").Formula = "=IFERROR(round($Y$50*数式! $C$8,2),"""")" Range("$AC$56").Formula = "=IFERROR(round($Y$56*数式! $C$9,2),"""")" Range("$AC$62").Formula = "=IFERROR(round($Y$62*数式! $C$10,2),"""")" Range("$AC$68").Formula = "=IFERROR(round($Y$68*数式! $C$11,2),"""")" Range("$AC$74").Formula = "=IFERROR(round($Y$74*数式! $C$12,2),"""")" Range("$AC$80").Formula = "=IFERROR(round($Y$80*数式! $C$13,2),"""")" Range("$AC$86").Formula = "=IFERROR(round($Y$86*数式! $C$14,2),"""")" Range("$AC$92").Formula = "=IFERROR(round($Y$92*数式! $C$15,2),"""")" Range("$AC$98").Formula = "=IFERROR(round($Y$98*数式! $C$16,2),"""")" Range("$AC$104").Formula = "=IFERROR(round($Y$104*数式! $C$17,2),"""")" Range("$AC$110").Formula = "=IFERROR(round($Y$110*数式! $C$18,2),"""")" Range("$AC$116").Formula = "=IFERROR(round($Y$116*数式! $C$19,2),"""")" Range("$AC$122").Formula = "=IFERROR(round($Y$122*数式! $C$20,2),"""")" Sheets("Table 2").Select Range("X2").Select End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/09/10 08:27 質問者: エクセル小僧

ベストアンサー

4

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

下記のマクロは先日教えて頂いたマクロです。指定シートの指定セル範囲指定数式をコピーできます。コードの str2 = "=IFERROR(ROUNDDOWN(($O$" & i & "+$P$" & i & "),3),"""")" 部分を =IFERROR(ROUNDDOWN(MIN(6*($O$4/$Q$4)-1.4,3),3),"3") に変更する方法を教えてください。尚、($O$4/$Q$4)の部分はO4及びQ4から4行づつで121まで以上になります。よろしくお願いいたします。

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

ベストアンサー

2

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

下記のマクロは指定シートの指定セル値に指定文字をコピーできます。指定シート名「Table 2」指定セル値「X$9」に指定文字「結　果」このコードの内、指定セル値「X$9」を6行づつ例えば「X$9」「X$15」「X$21」～「X$123」までの指定セルに変更出来る方法を教えてください。現状のマクロ Sub 文字をコピー() Sheets("Table 2").Select Range("X$9").Select ActiveCell.FormulaR1C1 = "結　果" End Sub 以上となります。よろしくお願いいたします。

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

ベストアンサー

2

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

下記のマクロコードをもう少し簡素化できる方法があれば教えてください。指定シート名「Table 2」で指定セルに指定計算式をコピーできます。現状のマクロ Sub 水平距離() Sheets("Table 2").Select Range("$Z$4").Formula = "=IFERROR(ROUNDDOWN(($O$4+$P$4),3),"""")" Range("$Z$5").Formula = "=IFERROR(ROUNDDOWN(($O$5+$P$5),3),"""")" Range("$Z$6").Formula = "=IFERROR(ROUNDDOWN(($O$6+$P$6),3),"""")" Range("$Z$7").Formula = "=IFERROR(ROUNDDOWN(($O$7+$P$7),3),"""")" Range("$Z$10").Formula = "=IFERROR(ROUNDDOWN(($O$10+$P$10),3),"""")" Range("$Z$11").Formula = "=IFERROR(ROUNDDOWN(($O$11+$P$11),3),"""")" Range("$Z$12").Formula = "=IFERROR(ROUNDDOWN(($O$12+$P$12),3),"""")" Range("$Z$13").Formula = "=IFERROR(ROUNDDOWN(($O$13+$P$13),3),"""")" Range("$Z$16").Formula = "=IFERROR(ROUNDDOWN(($O$16+$P$16),3),"""")" Range("$Z$17").Formula = "=IFERROR(ROUNDDOWN(($O$17+$P$17),3),"""")" Range("$Z$18").Formula = "=IFERROR(ROUNDDOWN(($O$18+$P$18),3),"""")" Range("$Z$19").Formula = "=IFERROR(ROUNDDOWN(($O$19+$P$19),3),"""")" Range("$Z$22").Formula = "=IFERROR(ROUNDDOWN(($O$22+$P$22),3),"""")" Range("$Z$23").Formula = "=IFERROR(ROUNDDOWN(($O$23+$P$23),3),"""")" Range("$Z$24").Formula = "=IFERROR(ROUNDDOWN(($O$24+$P$24),3),"""")" Range("$Z$25").Formula = "=IFERROR(ROUNDDOWN(($O$25+$P$25),3),"""")" 文字数の関係上途中省略 Range("$Z$118").Formula = "=IFERROR(ROUNDDOWN(($O$118$+P$118),3),"""")" Range("$Z$119").Formula = "=IFERROR(ROUNDDOWN(($O$119+$P$119),3),"""")" Range("$Z$120").Formula = "=IFERROR(ROUNDDOWN(($O$120+$P$120),3),"""")" Range("$Z$121").Formula = "=IFERROR(ROUNDDOWN(($O$121+$P$121),3),"""")" End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/09/09 08:40 質問者: エクセル小僧

ベストアンサー

4

0
vba 別ブックに転記

OSはwin11 エクセルはoffice365です。ご指導をいただきたいのは、下記の参考、　1の最終行の値を、2の最終行の次の行に転記です。条件　※列幅　A～H 　※1、2のブックは並列にウィドウズに表示　※参照図のように転記　※ブック2のＡ列は、mm/aa(aaa) 参考 1 ブック名 2024 外国為替 / シート名 Data /A B C D E F H列　※4行目の値、若しくは入力された最終行の値を2に転記　※ パス "C:\Users\04524\デスクトップ\keep\2024 外国為替.xlsm" 2 ブック名 2024 株価情報 / シート名為替 /A B C D E F H列　※4行目の値、若しくは入力された値の最終行の次の行に1からの値を転記　※ パス "C:\Users\04524\デスクトップ\keep\2024 株価取得.xlsm" 宜しくお願いします。

質問日時: 2024/09/09 06:05 質問者: chabindora

ベストアンサー

5

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

下記のマクロは以前教えて頂いたマクロで、マクロを実行すると、指定フォルダ内の指定ブックの指定シートを作業ブックのシートにコピーできます。コードの「\★" & Sheets("受付・名簿・工事名・日付").Range("F2").Value & "採光計算書.xlsx")」この部分ですが、このマクロを設定した時は、コピー元のファイル名が変更になるので、上記のコードとしてました。しかし、今回はファイル名「採光計算書.xlsx」が固定できますので、「\★" & Sheets("受付・名簿・工事名・日付").Range("F2")」このコードは不要となります。ファイル名を固定したマクロに変更出来る方法を教えてください。現状のマクロ Sub シートコピー() Dim myPath As String myPath = ThisWorkbook.Path With Workbooks.Open("\\nas-sp01\share\確認部\■意匠\戸建\★" & Sheets("受付・名簿・工事名・日付").Range("F2").Value & "採光計算書.xlsx") .Worksheets("Table 2").Cells.Copy ThisWorkbook.Worksheets("Table 2").Cells(1, 1) .Close False End With End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/09/05 12:57 質問者: エクセル小僧

ベストアンサー

3

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

下記のマクロを実行すると、指定したPDFファイルのオリジナル名（元々のファイル）の後ろに指定セル値「V1」の値がプラスされて、PDF名が変更になります。例えば「12345678-5北海　太郎.pdf」がオリジナル名「V1」に「_9月5日（交付用）」とあった場合にはマクロを実行すると「12345678-5北海　太郎_9月5日（交付用）.pdfと変更されます。このマクロですと、マクロ設定ブックのフォルダ内に変更されたPDFファイルが保存されてしまいます。元のPDFファイル（オリジナル）が保存されているフォルダ内に変更されたPDFファイルを保存出来る方法を教えてください。現状のマクロ Sub 交付用名前変更() Dim TargetFile As String Dim fPath As String, fname As String Dim newfName As String newfName = ThisWorkbook.Sheets("管理表").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 newfName = CreateObject("Scripting.FileSystemObject").GetBaseName(TargetFile) & newfName If Dir(fPath & "\" & newfName) = "" Then Name TargetFile As fPath & "\" & newfName Else Dim rc As Integer rc = MsgBox("既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", vbExclamation + vbYesNo, "置き換え確認") If rc = vbYes Then Kill fPath & "\" & newfName Name TargetFile As fPath & "\" & newfName 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/09/05 09:24 質問者: エクセル小僧

ベストアンサー

1

0
VBA コードどこがおかしいですか？

ＥｘｃｅｌでＣ2からデータが縦に5つずつ入力されています。そのデータをＧ列（Ｇ1から開始）に横にデータをはりつけたいのですがどこがおかしいでしょうか？添付画像は、実行した結果こうしたいという意味ではりつけてます。エラーになる個所は Cells(i, Q + 7) = myList(Z, 1) ' G列からK列にコピーです全体コード↓↓ Sub 縦リストを横リストに変換() Dim i As Long Dim Q As Long Dim Z As Long Dim lastRow As Long Dim myList As Variant ' C列のデータを配列に格納 myList = Range("C2", Range("C" & Rows.Count).End(xlUp)) ' 最終行を取得 lastRow = Cells(Rows.Count, 3).End(xlUp).Row Z = 1 ' 列をループ For i = 1 To lastRow / 5 ' 配列を5つ分ループ For Q = 0 To 4 Cells(i, Q + 7) = myList(Z, 1) ' G列からK列にコピー Z = Z + 1 Next Q Next i End Sub

質問日時: 2024/08/29 16:07 質問者: mihomiho34

ベストアンサー

3

1
VBA初心者です。次のVBAコードで、17行目を削除したいのですがうまく動きません改善策を教えてく

VBA初心者です。次のVBAコードで、17行目を削除したいのですがうまく動きません改善策を教えてください。 debug.printで確認した感じX17の値を取得できていないような感じもします。 sub test() if range("X7").value="false" then rows(17).delete end if end sub

質問日時: 2024/08/28 09:37 質問者: 中山あ

ベストアンサー

3

0
Vba UserformからExcelシートのサイズ変更について教えてください

いつもお世話になります今、UserFormからExcelシートのサイズが変更できなくて悩んでいます。本来のプログラムはUserFormからInputBoxで最小にしてあるシートのデータを参照するときにそのシートのサイズを最大にしたいのですが、上手くできません。下記のサンプルプログラムは質問用に作りました。 UserForm1を呼び出す前にシートのサイズを最小にして、 UserFirm1で最大にしているだけですが、出来ていません（Sample） Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Boolean Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) Sub test() '...ユーザフォームのクラス名を指定 FormClassName = "ThunderDFrame" '...ウィンドウのハンドルを取得 hwnd = FindWindow(FormClassName, vbNullString) '...表示（最小化されている場合は、これがないと表示状態になりません) check = ShowWindow(hwnd, 3) '...最前面表示 SetForegroundWindow hwnd VBA.AppActivate Excel.Application.Caption Application.WindowState = xlMinimized UserForm1.Show End Sub (UserForm1) Private Sub UserForm_Activate() UserForm1.Top = 100 UserForm1.Left = 600 VBA.AppActivate Excel.Application.Caption Application.WindowState = xlMaximized End Sub もし良い方法があれば教えてください以上、よろしくお願い申しあげます

質問日時: 2024/08/19 18:19 質問者: 公共ごま

ベストアンサー

1

0
VBA 円グラフ特定条件に一致したデータラベルの削除

Excel VBA（Office 365）で円グラフを作成。作成した円グラフにデータラベル（分類名+パーセンテージ）を追加したグラフがあります。円グラフに対して各データラベルを以下のコードで、「0%」という条件に合致したもののみを削除したいのですが、条件に対して大半は正しくヒットするのですが、なぜかヒットしないものがあります（データラベルが「0%」であるにも関わらず）。また、一部（すべてではありません）の「1%」のデータラベルがヒットして削除されてしまうこともあります。上記の不具合?はブレークポイントを設定せず（コードを止めずに）に実行すると生じます。 Next point_cntのところにブレークポイントを置いて、一つずつ動作を確認しながら実行すると、なぜか全く問題なく正常に動作します。以上の不具合?の改善方法、または、データラベルの特定条件条件検索とDeleteの他の方法について、お気づきの方が居りましたらご教授いただければ幸いです。 With ws.ChartObjects(.ChartObjects.count).Chart.SeriesCollection(.SeriesCollection.count) Dim point_cnt For point_cnt = 1 To .Points.count If .Points(point_cnt).DataLabel.Text Like "*" & vbLf & "0%" Then .Points(point_cnt).DataLabel.Delete End If Next point_cnt End With

質問日時: 2024/08/19 15:47 質問者: ぶつりがくっておいしいの

解決済

4

0
pdfファイルの複数添付引数の型

vbaでメール送信時にpdfファイルを2つ添付したいのですがファイル名の指定でエラーが出てしまいます。色々やってみたのですが、現在byref引数の型が一致しませんというエラーが出ていて進まなくなりました。教えてください。お願いします。 Sub sendMail_withattach() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("mail") Dim OutApp As Outlook.Application Set OutApp = New Outlook.Application Dim r As Long, lastrow As Long lastrow = ws.Cells(4, 1).End(xlDown).Row For r = 4 To lastrow Dim OutMail As Outlook.MailItem Set OutMail = OutApp.CreateItem(olMailItem) Dim attachFile As Outlook.Attachments Set attachFile = OutMail.Attachments Dim attachFile2 As Outlook.Attachments Set attachFile2 = OutMail.Attachments Dim BodyOfMail As String BodyOfMail = CreateBodyOfMail(ws, r) With OutMail .SendUsingAccount = Session.Accounts("aaa@bbb.com") .To = ws.Cells(r, 3).Value .Subject = ws.Cells(2, 5).Value .body = BodyOfMail End With Dim key As String key = ws.Cells(2, 11).Value Dim key2 As String key2 = ws.Cells(2, 11).Value Call AddAttach(attachFile, key) Call AddAttach(attachFile2, key2) OutMail.Display ' OutMail.Save OutMail.Send Set OutMail = Nothing Next r End Sub Sub AddAttach(attachFile As Object, attachFile2 As Object, key As String, key2 As String) Dim filename As String Dim filename2 As String Dim 案内 As String Dim チラシ As String filename = Dir(ThisWorkbook.Path & "\pdf\" & 案内 & "*") attachFile.Add ThisWorkbook.Path & "\pdf\" & filename filename2 = Dir(ThisWorkbook.Path & "\pdf\" & チラシ & "*") attachFile2.Add ThisWorkbook.Path & "\pdf\" & filename2 MsgBox filename & vbCrLf & filename2 Set attachFile = Nothing End Sub よろしくお願いいたします

質問日時: 2024/08/18 08:47 質問者: vba_miyuki

ベストアンサー

3

0
Excel_VBAについて質疑です。（for～next）

お世話になります。 1つのブックに「sheet1」と「sheet2」があります。 sheet1＝転記元（20名分のデータ） sheet2＝転記先名前1 sheet1のセルB2：B14を → sheet2のセルE･F10：E･F22に転記　（sheet2のE･Fはセル結合） sheet1のセルB16：B18を → sheet2のセルE･F23：E･F25に転記　（　　〃　　） sheet1のセルB19を → sheet2のセルE･F27に転記　（　　〃　　） sheet1のセルB20を → sheet2のセルE･F31に転記　（　　〃　　）名前2 sheet1のセルC2：C14を → sheet2のセルM･N10：M･N22に転記　（sheet2のM･Nはセル結合） sheet1のセルC16：C18を → sheet2のセルM･N23：M･N25に転記　（　　〃　　） sheet1のセルC19を → sheet2のセルM･N27に転記　（　　〃　　） sheet1のセルC20を → sheet2のセルM･N31に転記　（　　〃　　）名前3 sheet1のセルD2：D14を → sheet2のセルU･V10：U･V22に転記　（sheet2のU･Vはセル結合） sheet1のセルD16：D18を → sheet2のセルU･V23：U･V25に転記　（　　〃　　） sheet1のセルD19を → sheet2のセルU･V27に転記　（　　〃　　） sheet1のセルD20を → sheet2のセルU･V31に転記　（　　〃　　） 20名分のデータを転記（for～next ループ）させたいと思います。 VBAコードをご教示いただけますと幸いです。宜しくお願い致します。

質問日時: 2024/08/16 18:47 質問者: ちえのしつもん

ベストアンサー

4

0
ExcelVBAマクロで実行した時の疑問

NAS内のフォルダ内に置いたExcelVBAを実行した時の疑問です。そのフォルダは、ファイルの削除やリネームが出来ない権限設定にしています。マクロはそのファイルだ内にCSV出力したり出力ファイルのリネーム等をさせたりしているのですが、許可されていない権限のユーザがそのExcelを開いてマクロを実行すると、ファイル操作が問題なくできました。マクロが行うファイル操作というのは、NASから見た時実行したユーザがファイル操作をした事と同じとは見なされないんでしょうかね？細かい話ですみません。

質問日時: 2024/08/08 10:25 質問者: tanapyondai

解決済

2

0
VBAの間違い教えて下さい

このvbaどこが間違ってるでしょうか？条件合ってる気がするのですが指定ファイルがないと出ます。 Excelファイル名・ZAX0278A-11_4U07_MG-001486KED_20240727_OK ・C1セル；ZAX0278A-11　　・F1セル；4U07　　　・A6セル以降；1486KED Sub SearchAndListFiles() Dim ws As Worksheet Dim outputWs As Worksheet Dim folderPath As String Dim searchPattern As String Dim fileName As String Dim folderName As String Dim filePath As String Dim cell As Range Dim searchStr As String Dim baseFolder As String Dim formattedCellValue As String ' シートの設定 Set ws = ThisWorkbook.Sheets("Sheet1") Set outputWs = ThisWorkbook.Sheets("出荷時設定") ' セルの値を取得 Dim C1 As String, F1 As String C1 = ws.Range("C1").Value F1 = ws.Range("F1").Value ' C1に基づいて検索するフォルダーを決定 If C1 = "ZAX0278A-11" Then folderName = "ハンファ" ElseIf C1 = "ZAX0277A-11" Then folderName = "汎用" Else MsgBox "C1セルの値が無効です。" Exit Sub End If ' ベースフォルダーパスを設定（必要に応じてベースパスを調整） baseFolder = "C:\BaseFolder\" & folderName & "\" ' A列の6行目から下のセルをループ For Each cell In ws.Range("A6:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' A列のセル値を6桁になるように変換 formattedCellValue = Format(Mid(cell.Value, 1, Len(cell.Value) - 3), "000000") & Right(cell.Value, 3) ' 検索パターンを生成 searchPattern = "*" & C1 & "_" & F1 & "_*-" & formattedCellValue & "*OK*.xlsx" ' パターンに一致するファイルを検索 fileName = Dir(baseFolder & searchPattern) ' ファイルが見つかった場合 If fileName <> "" Then Do While fileName <> "" ' 見つかったファイル名を「出荷時設定」シートに書き込む outputWs.Cells(outputWs.Cells(outputWs.Rows.Count, "A").End(xlUp).Row + 1, 1).Value = fileName ' 次のファイル名を取得 fileName = Dir() Loop Else MsgBox "ファイルが見つかりませんでした: " & searchPattern End If Next cell MsgBox "検索が完了しました。" End Sub

質問日時: 2024/08/03 21:35 質問者: ケイ0000

解決済

5

1
Vba ファイル書き込み時に書き込みエラーを回避する方法を教えてください

いつもお世話になります今、Scriptファイルを利用してExceのデータでAutoCad上に作画させていますが時々データ量および処理速度の差によって、Scriptファイルの書き込みエラーが発生します今はApplication.Waitで調整していますが、妙案があったら教えてください '...ファイルの定義 Set stm = New ADODB.Stream stm.Charset = "UTF-8" stm.LineSeparator = adLF stm.Open 　　（作図）ファイル作成 Application.Wait [Now() + "00:00:03"]　　　 '...エラーが起きないように3秒調整 stm.SaveToFile PLTFname1, 2　　　　　　　　'...ファイル書き込み（ここでエラーが起きる） stm.Close Application.Wait [Now() + "00:00:01"] SendKeys "script" & Chr(13) & PLTFname1 & Chr(13) stm.Open 　　（作図） Application.Wait [Now() + "00:00:03"] stm.SaveToFile PLTFname1, 2 　　　・　　　・　（作図とScript 処理を繰り返します）いつもすみません、変な質問で以上、よろしくお願い申しあげます

質問日時: 2024/08/01 14:34 質問者: 公共ごま

ベストアンサー

4

0
vbs ブック共有を解除

vbsでドラッグアンドドロップしたExcelファイルのブック共有解除　 ActiveWorkbook.UnprotectSharing ActiveWorkbook.ExclusiveAccess を行いたいのですがうまくいきませんご教示いただけますと幸いです。 ▼ VBScriptを使ってExcelファイルを開き、共有を解除 ' エラーハンドリングを有効にする On Error Resume Next ' Excelアプリケーションオブジェクトを作成する Set objExcel = CreateObject("Excel.Application") ' Excelアプリケーションの警告を表示しないように設定 objExcel.DisplayAlerts = False ' コマンドライン引数（ドラッグアンドドロップ）からファイルパスを取得 Set objArgs = WScript.Arguments If objArgs.Count = 0 Then ' Excelアプリケーションを終了し、オブジェクトを解放 objExcel.Quit Set objExcel = Nothing WScript.Quit End If filePath = objArgs(0) ' ファイルが存在するか確認 If CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then ' Excelファイルを開く　 ' 共有を解除 Set objWorkbook = objExcel.Workbooks.Open(filePath) ActiveWorkbook.UnprotectSharing ' ワークブックを閉じる objWorkbook.Close False End If ' Excelアプリケーションを完全に終了する objExcel.Quit Set objWorkbook = Nothing Set objExcel = Nothing ' エラーハンドリングを解除 On Error GoTo 0

質問日時: 2024/07/28 03:25 質問者: 名無しの受験生

解決済

2

0
Vba TextBox1.ControlSourceについて教えてください

いつもお世話になります今、Userformにおいてテキストボックスに値またはリンク先アドレスの入力を併用できないか考えていますリンク先のアドレス入力は On Error Resume Next Set Target = Application.InputBox("「柱の高さ」データセルを選択", Left:=500, Top:=100, Type:=8) If Err.Number > 0 Or Target.Address = "" Then '..キャンセル時、また入力無し Exit Sub End If On Error GoTo 0 Targetadd = Target.Address(False, False) TargetWS = Target.Worksheet.Name TextBox4.Enabled = False '...TextBox4.ControlSourceにセットした後にTextBox4の値を手動でクリアするとExcelシートの値が消えるので編集不可にした With TextBox4 .ControlSource = TargetWS & "!" & Targetadd End With としていますが Application.InputBoxに直接、数値を入力したときもそのままValueとして扱える方法はあるのものですか？以上、いつも変な質問ばかりですみませんが分かりましたら教えてください

質問日時: 2024/07/26 15:36 質問者: 公共ごま

ベストアンサー

3

0
サブフォルダに格納されているファイルを、ファイル名ごとに条件分岐させたい

お世話になっております。当方VBA初心者のため、ご教示ください。張りつけするファイル(xlsx)と同フォルダ内に「Voltから始まるファイル(CSV)」と「Currから始まるファイル(CSV)」が大量にサブフォルダに格納されています。 Voltの時とCurrの時ではりつける場所を変えるマクロが知りたいです。また、グラフの作成(範囲の修正)もしたいです。 ①開くサブフォルダを指定する (調べていて見つけたのが、ダイアログボックスでフォルダを指定するタイプでした。) ②Voltの時、C5～C135に入力されている数値をコピー、別ファイルのAK6に貼り付けるファイルごとに最終列の隣へどんどん貼り付けていく ③ファイルごとに数字を追加フォルダが変わると数字を1～にする ※1フォルダにVolt5個、Curr5個程度(どちらもたまに6個)入っています。 2行目にフォルダの日付、3行目に1～、4行目に1回目～5回目(たまに6回目)と記載したい 3行目のフォルダ数は日付によって違います。 ④貼り付ける前でも後でも良いのですが、1行ごとに空白行を挿入する例）AK141：0.365 AK142：空白 AK143：0.412 ⑤折れ線グラフの作成貼り付けた6行目と141行目の1行を折れ線グラフにする(空白行は飛ばしてすべての行を128個作成) グラフについては、すでにAJ列まで作成済みのものがありますので、可能であれば追加した列分の範囲の修正を行いたいです。上記のことがしたいのですが、初心者なため、サンプルコードをいただけるとありがたいです。また、マクロで再現が難しいということがあればご教示願います。お手数をおかけしますが、よろしくお願いいたします。

質問日時: 2024/07/22 10:36 質問者: maaaaatam

解決済

1

0
IF文、条件分岐の整理方法

プログラミング初学者です。添付画像の条件分岐を簡潔なコードにしたいです。 IF文のみで記述しようとしましたがもっと簡単に考えることができるのでは無いかと思っています。丸々コードにして頂かなくて結構ですので関数としてコードをわける、戻り値を使用するなど考え方だけでもアドバイスいただければ幸いです。

質問日時: 2024/07/19 21:21 質問者: mmmmo777

ベストアンサー

6

1
VBAコードのインデント表示

Visual Basic（VBA）のカテゴリーにマクロコード付きの質問が投稿されますが、Webブラウザで見るとインデント表示されなくて見る気がしません。スマホアプリで見るとインデントされていますが、画面が小さいので辛いです。改善方法はあるでしょうか？

質問日時: 2024/07/18 14:13 質問者: いんちょ

ベストアンサー

2

0
【ExcelVBA】値を変更しながら連続でPDFを作成し，ファイル名を自動で付して出力するコード

「回答」シートにおいて１行に１件ずつデータが入っており，I２セルからI3セルで行番号を始点，終点として指定すると「様式」シートに指定した行のデータが順番に反映され，それらを結合した状態で出力し，ファイル名はI2セルに入力した行のデータ容に則したものになるコードについて伺います。以前，この掲示板で質問させていただいおり，そのときは「ファイル名はI2セルに入力した値のときに「様式」シートに反映される内容に則したものにしたい」という条件がなかったため，そのときに教えていただいたコードに修正を加えたものが以下のコードですがエラーで止まってしまいます。（l = Sheets("回答").Range("N7").Value &～の部分で止まってしまいます）どのように修正したらよいか，ご教示願います。 Sub 連続PDF作成() Dim stK, stY, stD Dim startN, endN, i As Long Const AA = "A1:H40" ' ← コピー(転記)対象のセル範囲 Dim l As String ' ← 作成するPDFファイル名 Set stK = Worksheets("回答") Set stY = Worksheets("様式") startN = stK.Range("I2").Value endN = stK.Range("I3").Value If Application.CountBlank(stK.Range("I2:I3")) > 0 Or _ Not (IsNumeric(startN) And IsNumeric(endN)) Then _ MsgBox "無効な入力です": Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False stY.Copy With ActiveWorkbook Set stD = ActiveSheet For i = startN To endN stK.Range("A5").Value = stK.Cells(i + 9, 1).Value stD.Copy after:=.Worksheets(.Worksheets.Count) .Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value Next i stD.Delete stK.Range("A7").Value = stK.Cells(startN + 9, 1).Value l = Sheets("回答").Range("N7").Value & "・" & Sheets("回答").Range("G7").Value & "・" & Sheets("回答").Range("D7").Value .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & l & ".pdf" .Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

質問日時: 2024/07/16 17:12 質問者: qazxcvfr4

ベストアンサー

6

0
時間短縮のために、テキストファイルの入出力をメモリを使って出来ないですか？

いつもお世話になります今、400行のデータをExcelからScriptファイルを使ってAutoCadに出力していますその際、ファイルは保存形式UTF-8で Set stm = New ADODB.Stream stm.Charset = "UTF-8" stm.LineSeparator = adLF としていますデータ列は13列、一行づつScriptファイルを作りAtuoCadに送ります For Row = 1 To GridRows　　 '...行のループ stm.Open '...ファイルオープン For Col = 1 To GridCols '...列のループ With CellInfo(Row, Col) '...セル情報 If .Text <> "" Then moji1 = CStr(.TextX) & "," & CStr(.TextY) '出力座標値 moji2 = CStr(TextHeight) '文字サイズ moji3 ="0.0" '文字出力角度 strRec = "-Text" & vbCrLf & opt & vbCrLf & moji1 & vbCrLf & _ moji2 & vbCrLf & moji3 & vbCrLf & .Text stm.WriteText strRec, 1 '...ファイル書き出し End If End With Next Col Application.Wait [Now() + "00:00:00.2"] '...0.2秒待つ stm.SaveToFile PLTFname, 2 '...ファイル保存 stm.Close '...ファイルを閉じる Application.Wait [Now() + "00:00:00.1"] '...0.1秒待つ SendKeys "script" & Chr(13) & PLTFname & Chr(13) '...Scriptファイルの実行 Application.Wait [Now() + "00:00:00.1"] '...0.1秒待つ Next Row '（原点は選択セルの左上としています） AutocadにScriptコマンドを送るときには前後に0.1秒 stmファイル書き出しには、「出力エラーが」が出るため0.1秒から0.2秒待たせますこの小さな時間が積み重なって、結構な時間になります 0.2秒待ちで、3分12秒 0.1秒待ちで、2分27秒目標はあと1分短縮させたいのですが、stmの出力先にメモリを使えないかと相談しました以上、良いご回答を期待していますよろしくお願い申し上げます

質問日時: 2024/07/13 15:33 質問者: 公共ごま

ベストアンサー

7

1
Excel VBA 選択範囲の罫線色の変更プロージャの動作速度の改善について

次はエクセルで既に設定されている罫線の色を一括変更するプロージャーですが、表形式のシートで実行してみると結構動作が遅いです。高速化できますか？ Sub 罫線色変更() Application.ScreenUpdating = False Dim r As Range Dim i As Long Application.Dialogs(xlDialogEditColor).Show (1) For Each r In Selection For i = 7 To 10 If r.Borders(i).LineStyle <> xlNone Then r.Borders(i).Color = ActiveWorkbook.Colors(1) End If Next i Next r Application.ScreenUpdating = True End Sub

質問日時: 2024/07/06 18:02 質問者: tsukita

ベストアンサー

9

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

下記のマクロを実行すると作業ブックのセル値がAccessの指定セル値にコピーできます。このコードの内「 rs.Fields("備考欄") = ws.Range("E29").Value」ですがセルの書式設定で「"希望日"m/d"急ぎ";@」と設定しているのですが、実行するとAccessの（備考欄）には：日付のみがコピーされております。書式設定したように「希望日7/5急ぎ」をコピー出来る方法を教えてください。現状のマクロ Sub 昇降機管理表() alert = MsgBox("Accessにデータ移動してよろしいですか？", vbYesNo + vbQuestion, "Access確認") If alert <> vbYes Then Exit Sub End If Dim ws As Worksheet: Set ws = Worksheets("基本情報") Dim db As String: db = "\\nas-sp01\share\新・確認申請管理表.accdb" Dim cn As Object: Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db & ";" Dim rs As Object: Set rs = CreateObject("ADODB.Recordset") rs.Open "確認申請（建築物）", cn, 1, 3 rs.AddNew 'rs.Fields("ID") = ws.Range("A1").Value rs.Fields("受付NO(ＥＲＩ)") = ws.Range("F17").Value rs.Fields("物件名") = ws.Range("AJ4").Value rs.Fields("正受付日") = ws.Range("D29").Value rs.Fields("確認予定日") = ws.Range("D30").Value rs.Fields("意匠法定通知（送付）") = ws.Range("D31").Value rs.Fields("市町村名") = ws.Range("C8").Value rs.Fields("代理人") = ws.Range("C4").Value rs.Fields("主要用途") = ws.Range("AH2").Value rs.Fields("ＥＲＩ担当") = ws.Range("D16").Value rs.Fields("備考欄") = ws.Range("E29").Value rs.Update rs.Close cn.Close End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/07/05 10:32 質問者: エクセル小僧

ベストアンサー

1

0
ワードVBA どの表か知ることはできますか

ワードで、表がいくつかあるのですが、現在のカーソルがどのセルにあるか知ることはできますか。

質問日時: 2024/07/05 10:19 質問者: payphone

ベストアンサー

1

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

下記のマクロを実行するとセル「H5」をセル「L2」にコピペできます。マクロを実行した時にセル「L2」に不特定の文字が先に表示されているときにこのマクロを実行しても「L2」に上書きされない方法があれば教えてください。現状のマクロ Sheets("受付").Range("L2").Value _ = Sheets("受付").Range("H5").Value End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/07/04 16:21 質問者: エクセル小僧

ベストアンサー

1

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

マクロ設定ブックのThisWorkbookに下記のコードを設定しております。作業ブックをオープンしたタイミングで、「マクロ：提出シートコピー削除」が実行できますが、この作業が完了した後、別ブック名「物件毎のファイル名.xlsm」に保存後、違う作業に移行しますが、別ブックに保存した、ブックをオープンすると、又、「マクロ：提出シートコピー削除」が実行されてしまいます。 ThisWorkbookに設定したコードを一度だけ実行できる方法又は、最初のマクロ有効ブックのファイル名「総合引き受け（戸建て）.xlsm」（ファイル名は固定です）の時だけ実行でき、ファイル名が変更後は、コードが実行されない方法があれば教えてください。現状のコード Private Sub Workbook_Open() Dim alert As VbMsgBoxResult alert = MsgBox("提出シートを貼り付けますか？", vbYesNo + vbQuestion, "貼り付け確認") If alert <> vbYes Then Exit Sub End If Call 提出シートコピー削除 End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/07/04 10:13 質問者: エクセル小僧

ベストアンサー

2

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

下記のマクロは先日教えて頂いたマクロで、マクロを実行すると同じ作業フォルダ内にある別ブック（拡張子が.xlsx）を開きコピー範囲を指定出来るようになっております。稀に、（拡張子が.xlsm）の場合もあり、拡張子が（.xlsx又は.xlsm）の両方に対応できるように変更出来る方法があれば教えてください。尚、フォルダ内には、作業ブック（マクロ設定ブック）とコピー元のExcelファイル2つしかありません。よろしくお願いいたします。現状のマクロ Sub 提出シートコピー範囲() Dim folderPath As String Dim fileName As String Dim ws As Worksheet folderPath = ThisWorkbook.Path & "\" '作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の '○〇(提出用).xlsxの 2つのExcelファイルしかありません｡ fileName = Dir(folderPath & "*.xlsx") If fileName <> "" Then '別ブック ○〇(提出用).xlsx Set Wb2 = Workbooks.Open(folderPath & fileName) On Error Resume Next Set ws = Wb2.Worksheets("提出シート") If Err.Number <> 0 Then MsgBox "コピー元ブックの提出シートが見つかりません" On Error GoTo 0 Wb2.Close False End End If 'セルの値を取得する ws.Range("B1:H47").Copy Else MsgBox "コピー元ブックが見つかりません": End End If End Sub よろしくお願いいたします。

質問日時: 2024/07/04 08:52 質問者: エクセル小僧

ベストアンサー

3

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

下記のコードは先日教えて頂いたコードを参考に作成しました。セルＤ47に不特定の文字が表示されるとマクロ住所コピーが実行されます。しかし、セルＤ47があるシートを他のブックのシートからコピペした場合はマクロが上手く実行されません。セルＤ47に直接書き込むとマクロが事項されます。この問題を解決できる方法を教えてください。よろしくお願いいたします。 If Not Intersect(Range("$D$47"), Target) Is Nothing And Not Target.Value <> "" Then Call 住所コピー以上となります。よろしくお願いいたします。

質問日時: 2024/07/03 17:47 質問者: エクセル小僧

ベストアンサー

1

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

下記のマクロは先日教えて頂いたマクロで、マクロを実行すると、ワイルドカードで指定したブックを開く事が出来ます。ファイル名 ①22069167-1_00－確認申請受付【花子】(提出用).xlsx の場合は上手くマクロが実行されてブックを開く事が出来ますが。 ②210610132-1_東二条7丁目住宅新築工事【太郎】(提出用) .xlsx の場合は"コピー元ブックが見つかりません"を表示されてブックを開く事が出来ません。下記のコードを変更し、①の場合も②の場合も両方ブックを開く事が出来る方法があれば教えてください。よろしくお願いいたします。現状のマクロ Sub 提出シートを開く() Dim folderPath As String Dim fileName As String folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*(提出用).xlsx") Do While fileName <> "" Workbooks.Open (folderPath & fileName) fileName = Dir() Loop End Sub Sub 提出シートコピー範囲() Dim ws As Worksheet If Workbooks.Count > 1 Then Set Wb2 = Workbooks(2) '別ブック On Error Resume Next Set ws = Wb2.Worksheets("提出シート") If Err.Number <> 0 Then MsgBox "コピー元ブックの提出シートが見つかりません" On Error GoTo 0 Wb2.Close False End End If 'セルの値を取得する ws.Range("B1:H47").Copy Else MsgBox "コピー元ブックが見つかりません": End End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/07/03 09:22 質問者: エクセル小僧

ベストアンサー

7

0
ExcelVBA修正のお願い

・Excel(M365)で、添付ファイルが実行できるようなVBAを作成しましたが、おかしな点を修正していただけませんでしょうか。＜具体的に実施したいこと＞・①Sheet1のE列と、Sheet2のC列をマッチングし、Sheet1のJ列の値を、Sheet2のM列へ転記する。その際、Sheet1にデータ重複している場合（例：CCC,DDD）、そのデータの最下行の値を転記する（例：CCC→400、DDD→700）②この重複データについては、アラームのため、該当するSheet2のB~C列を赤くセル反転させる。・上記マッチングしない場合は、Sheet2へは特に転記はしない（例：EEE）・Sheet2については、11行目に項目があり、12行目以降へデータ転記したい。 ↓以下の通り作成しましたが、「Sheet2については、11行目に項目があり、12行目以降へデータ転記したい。」「該当するSheet2のB~C列を赤くセル反転させる。」という部分をうまく反映できていないように感じていますが、どのように修正すればよいかを教えてください。。 Sub sample() Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1") Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2") Dim i As Long, j As Long, r1 As Long, r2 As Long Dim k As Long, cnt As Long Dim ary ws1.Select With ws1 r1 = .Cells(Rows.Count, "E").End(xlUp).Row ReDim ary(1 To r1, 1 To 2) For i = 1 To r1 ary(i, 1) = .Cells(i, "E").Value ary(i, 2) = .Cells(i, "J").Value Next i End With With ws2 r2 = .Cells(Rows.Count, "C").End(xlUp).Row For i = 1 To r2 cnt = 0 For j = 1 To UBound(ary, 1) If .Cells(i, "C") = ary(j, 1) Then k = j cnt = cnt + 1 End If Next j If k > 0 Then .Cells(i, "M").Value = ary(k, 2) '値段転記 If cnt > 1 Then .Cells(i, "M").Interior.ColorIndex = 3 '重複値赤 k = 0 End If Next i End With End Sub

質問日時: 2024/07/02 23:06 質問者: mame1216

ベストアンサー

1

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

下記のコードは以前教えて頂いたコードです If Not Intersect(Range("ER3"), Target) Is Nothing And Target.Value = "■" Then Call Accessシート表示指定セル値に指定文字「■」が表示されるとマクロが実行できます。このコードを指定セル値に「■」では無く、不特定の文字が表示されたときにマクロを実行出来るように変更する方法を教えてください。又、マクロは「Call Accessシート表示」ですが、複数のマクロ（例えば：テスト1・テスト2）を設定したいのですが、よろしくお願いいたします。

質問日時: 2024/07/02 12:34 質問者: エクセル小僧

ベストアンサー

3

0

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

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

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

質問する（無料）

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

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

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

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

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

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