重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら＞

電子書籍の厳選無料作品が豊富！

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

回答数

気になる

  • エクセルVBAでデータ転記

    VBAに詳しい方、データ転記について教えていただけますでしょうか。 スクリーンショットの通り、Book1とBook2のエクセルがあります。 Book2をコピーし、新しいブックBook3として保存します。Book1のA列が1~4に対するB列が１より大きいの時のみ、B列該当のデータをBook3に転記します。同様に、Book1のA列が101~105に対するB列が１より大きいの時のみ、B列該当のデータもBook3に転記します。 ※Book1とBook2に行を追加する可能性がある為、For～Next文で行番号を一行ずつ移動させることはやめたいです。 ご存知の方、よろしくお願いいたします！

    質問日時: 2024/01/28 20:11 質問者: 勉強好きか

    解決済

    1

    0

  • 【VBA】カーソルのある行の１行目のセルをコピペし，最後にそのセルに戻る方法

    Excel VBAのことで伺います。office365を使用しています。 以下のとおりマクロを作りましたが，次の動きをするマクロにしたいと思っています。 コピペ元のセル番地を格納する変数が必要だと思うのですが，どのようにそれを宣言すれば良いか等ご教示願います。（今の状態だと，常にB5セルにカーソルが移動して終了してしまいます） ①　「回答」シートにおいてカーソルのある行のA列の値を，B５セルにコピペ ②　「様式」シートの範囲指定した箇所を印刷 ③　「回答」シートの①の動作のときにカーソルのあった行のＡ列のセル（要は，コピペ元のセル）に戻る。 以下　現状のコード ---------------------------------------------------------------------------------------------- Sub 印刷() Sheets("回答").Cells(Selection.Row, 1).Select Selection.Copy Sheets("回答").Range("B5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Application.Goto Sheets("回答").Range("B5") End Sub

    質問日時: 2024/01/26 16:48 質問者: qazxcvfr4

    ベストアンサー

    3

    0

  • VBAの質問です、複数のテキストボックスに同じコメントを

    目的としては管理番号の作成になります TextBox１に数桁の数字を入力します その数字の語尾にアンダーバーとカウント数を付け足そうと思ってます。(123456_1) 安易な考えで下記の使用ができれば別Boxでカウント数を入力すればOKかなと(;^_^A UserForm内でテキストボックスに入力したコメントを同じフォーム内の 別ボックスにも表示させたいのですがどのようなコード、又はプロパティで設定できますか？ そもそもこのようなことができないのでしょうか？ それかTextBox１に入力した数字にsheet転記時にカウント数を自動追加できるのでしょうか？ TextBox1の転記先はD列、管理番号の転記先はK列になります

    質問日時: 2024/01/26 09:37 質問者: kacky76

    解決済

    1

    0

  • ＥｘｃｅｌVBAのFindFirstエラーについて

    Set iCnd = uiAuto.CreatePropertyCondition(UIA_AutomationIdPropertyId, "addSerifTextBox") Set elmYukkuri_textbox = elmYukkuri_timeline.FindFirst(TreeScope_Subtree, iCnd) If elmYukkuri_textbox Is Nothing Then i = MessageBoxTimeoutA(0&, "addSerifTextBox" & Chr(13) & "がみつかりません", "FindFirstエラー", vbMsgBoxSetForeground, 0&, 10000) Exit Sub End If FindFirstエラーでＥｘｃｅｌVBAマクロが実行できません。正しい値?を取得したいのですが、何をすれば良いのかが分かりません。Accessibility Insights for Windows で調べた値に書き換えたりもしましたが上手くいきません。正しい値?名前?を取得する方法が知りたいです。

    質問日時: 2024/01/23 13:52 質問者: atasarrrrrrr

    ベストアンサー

    1

    0

  • マクロのエラー

    d(i, 2) = Sheets(1).Range("J58") 上記を以下のAX12に変更 d(i, 2) = Sheets(1).Range("AX12") d(i, 2) = Sheets(2).Range("J58") 上記を上記を以下のAX12に変更 d(i, 2) = Sheets(2).Range("AX12") を変更したところ型が一致しませんと出て If Val(d(i, 2)) = 0 Then の部分が黄色くなってしまいます どこを直せばいいのでしょうか For i = 1 To cnt If Left(d(i, 1), 1) = "G" Then Sheets(1).Range("J5") = d(i, 1) d(i, 2) = Sheets(1).Range("AX12") Sheets(1).Range("J5") = "" End If Next For i = 1 To cnt If Left(d(i, 1), 1) = "T" Then Sheets(2).Range("J5") = d(i, 1) d(i, 2) = Sheets(2).Range("AX12") Sheets(2).Range("J5") = "" End If Next For i = 1 To cnt For j = 4 To 48 If Sheets("集計").Cells(j, 1) = d(i, 1) Then If Val(d(i, 2)) = 0 Then d(i, 2) = 0 Sheets("集計").Cells(j, ComboBox1 + 2) = d(i, 2) End If Next Next End Sub

    質問日時: 2024/01/19 19:50 質問者: tokoro42811

    ベストアンサー

    5

    2

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

    下記のマクロは指定フォルダ内にあるワイルドカード名のフォルダを削除できます。 対象フォルダが無い場合はエラーが表示されません「On Error Resume Next」 コードのワイルドカードの 「\*12345678*"」この部分の「12345678」を指定セル値に置き換えが出来る方法を教えてください。 指定セル値シート名「青紙表」セル値「R18」 以上となります。 現状のマクロ Sub フォルダ削除() On Error Resume Next Dim fso As Object Dim strPath As String Set fso = CreateObject("Scripting.FileSystemObject") strPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書\8\*12345678*" fso.DeleteFolder strPath, True Set fso = Nothing End Sub 以上です。 よろしくお願いいたします。

    質問日時: 2024/01/18 15:48 質問者: エクセル小僧

    ベストアンサー

    1

    0

  • マクロについて教えてください。 下記のマクロは以前教えて頂いたマクロです。 マクロを実行すると 指定

    マクロについて教えてください。 下記のマクロは以前教えて頂いたマクロです。 マクロを実行すると 指定セル値シート名「青紙表」のセル値「R18」に表示されている、数字と同じ数字を含むフォルダをマクロ有効ブックが保存されているフォルダ内にコピーできます。 マクロを実行し、対象フォルダが作業フォルダ内にコピーされた後は コピー元のフォルダは不要になりますので コピー後に不要フォルダを削除出来る方法を教えてください。 例えば セルR18に「12345678」と表示されており 検索指定フォルダ先 「\\nas-sp01\share\確認部\■01_敷地照会回答書\8」内に 「ERI12345678（回答）テスト」のフォルダがあると 指定セル値「12345678」とフォルダ名の数字「12345678」とが一致いますので 「ERI12345678（回答）テスト」が作業フォルダにコピーされます。 コピー後は「\\nas-sp01\share\確認部\■01_敷地照会回答書\8」内にあるコピー元の「ERI12345678（回答）テスト」が不要になりますので、削除したいのですが このマクロに追加のコードで削除出来る方法を教えてください。 現状のマクロ Sub 行政回答フォルダ確認() Dim i As Long Dim FSO As Object Dim strKeyword As String Dim strFolderPath As String, strFolderName As String Dim arrMoveFolders As Variant Dim strOriginPath As String, strDestPath As String If MsgBox("フォルダを検索しますか", vbOKCancel) <> vbOK Then Exit Sub Set FSO = CreateObject("Scripting.FileSystemObject") strKeyword = CStr(Sheets("青紙表").Range("R18").Value) If strKeyword = "" Then MsgBox ("キーワードが空白です"): Exit Sub strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書" strDestPath = ThisWorkbook.Path If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - Len("\")) ReDim arrMoveFolders(0 To 1, 0 To 0) For i = 0 To 9 strFolderPath = strOriginPath & "\" & i strFolderName = Dir(strFolderPath & "\*" & strKeyword & "*", vbDirectory) Do Until strFolderName = "" If Replace(strFolderName, ".", "") <> "" Then If arrMoveFolders(0, 0) <> Empty Then ReDim Preserve arrMoveFolders(UBound(arrMoveFolders, 1), UBound(arrMoveFolders, 2) + 1) arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & "\" & strFolderName arrMoveFolders(1, UBound(arrMoveFolders, 2)) = strFolderName strFolderName = Dir End If Loop Next If arrMoveFolders(0, 0) = Empty Then MsgBox "該当フォルダがありません" Exit Sub Else If MsgBox("該当フォルダがありました、フォルダを移動しますか", vbOKCancel) <> vbOK Then Exit Sub End If For i = 0 To UBound(arrMoveFolders, 2) FSO.CopyFolder arrMoveFolders(0, i), strDestPath & "\" & arrMoveFolders(1, i) Next End Sub 以上となります。よろしくお願いいたします。

    質問日時: 2024/01/17 17:50 質問者: エクセル小僧

    ベストアンサー

    6

    0

  • 列の順番を入れ替えて吐き出

    下記のコードで吐き出すときに 列の順番を入れ替えて吐き出すことは可能でしょうか Dim x x = Range("A1").CurrentRegion.Value Range("G1").Resize(UBound(x, 1), UBound(x, 2)) = x

    質問日時: 2024/01/17 15:09 質問者: りんごプリン

    ベストアンサー

    4

    0

  • vbaでxmlからNodeListでデータがない時、空欄で取得する方法

    <?xml version="1.0" encoding="utf-8"?> <customer> <customer_no>123456</customer_no> <last_name>山田</last_name> <first_name>太郎</first_name> </customer> <customer> <customer_no>154653</customer_no> <last_name>山田</last_name> </customer> 上記のようなxmlから、customer_no、last_name、first_nameをNodeListでEXCELに取得しております。 2番目のレコードにfirst_nameのデータがないので、first_nameというタグもありません。 NodeListでEXCELにはきだすと、データがない箇所は詰めて取得されるのでずれてしまいます。 データがない場合は空欄で取得させたいです。 どなか教えていただけますでしょうか？

    質問日時: 2024/01/17 13:33 質問者: アヤスカル1213

    ベストアンサー

    1

    0

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

    下記のマクロは以前教えて頂いたマクロで マクロを実行すると 指定フォルダ内のサブフォルダ「0」～「9」までのフォルダに保存されている PDFファイル名を半角英数字8文字に変更できます。 例えば 「ABC12345678」を「12345678」に変更 しかし、稀にファイル名が 「3-46(ABC-24000760).pdf や 「(ABC-24000760).pdf」などなど 色々な文字の場合があります。 「3-46(ABC-24000760).pdfの場合でも「24000760」に 「(ABC-24000760).pdf」の場合でも「24000760」にファイル名を変更出来る方法を教えてください。 変更前のファイル名が、必ず連続した、半角英数字8文字で 変更後も 必ず連続した、半角英数字8文字（変更前と同じ数字）となるようにお願いいたします。 現状のマクロ Sub 行政回答ファイル名変更() Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") Dim i As Long Dim strFolderName As String Dim arrFolderPaths As Variant Dim strFileName As String Dim strNewFileName As String Dim strFullPath As String Dim strNewFullPath As String Const strFileHeader As String = "*ERI" Const strParentFolderPath As String = "\\nas-sp01\share\確認部\■01_敷地照会回答書" ReDim arrFolderPaths(0 To 0) strFolderName = Dir(strParentFolderPath & "\*", vbDirectory) Do Until strFolderName = "" If Replace(strFolderName, ".", "") <> "" Then If GetAttr(strParentFolderPath & "\" & strFolderName) And vbDirectory Then ReDim Preserve arrFolderPaths(UBound(arrFolderPaths) + 1) arrFolderPaths(UBound(arrFolderPaths)) = strParentFolderPath & "\" & strFolderName End If End If strFolderName = Dir Loop For i = 1 To UBound(arrFolderPaths) strFileName = Dir(arrFolderPaths(i) & "\*.pdf") Do Until strFileName = "" If StrConv(strFileName, vbNarrow) Like strFileHeader & "*" & ".pdf" Then strNewFileName = newName(strFileName) If strNewFileName <> "" Then strFullPath = arrFolderPaths(i) & "\" & strFileName strNewFullPath = arrFolderPaths(i) & "\" & strNewFileName If FSO.FileExists(strNewFullPath) Then Kill strFullPath Else Name strFullPath As strNewFullPath End If End If End If strFileName = Dir Loop Next End Sub Function newName(name_org As String) As String Dim i As Long For i = 1 To Len(name_org) If Mid(name_org, i, 1) Like "[0-9]" Then newName = Mid(name_org, i, 8) & ".pdf" Exit Function End If Next End Function 以上となります。よろしくお願いいたします。

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

    ベストアンサー

    3

    0

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

    下記のマクロは先日教えて頂いたマクロで、マクロを実行すると指定セル値に該当するサブフォルダ名がマクロ設定ブックと同じフォルダ内に移動できます。 このマクロを下記の内容に変更出来る方法を教えてください。 指定セル値「R18」に表示されている数字とサブフォルダ名の数字とが一致し、 メッセージボックスで「該当フォルダがありました、フォルダを移動しますか」と表示され、「OK」をクリックすると「ダイアログが開き、自身で指定したフォルダ内に移動できるように変更出来る方法を教えてください。 現状のマクロ Sub Macro1() Dim i As Long Dim strKeyword As String Dim strFolderPath As String, strFolderName As String Dim arrMoveFolders As Variant Dim strOriginPath As String, strDestPath As String strKeyword = CStr(Sheets("青紙表").Range("R18").Value) If strKeyword = "" Then MsgBox ("キーワードが空白です"): Exit Sub If MsgBox("フォルダを検索しますか", vbOKCancel) <> vbOK Then Exit Sub Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書" strDestPath = ThisWorkbook.Path If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - Len("\")) ReDim arrMoveFolders(0 To 1, 0 To 0) For i = 0 To 9 strFolderPath = strOriginPath & "\" & i On Error Resume Next strFolderName = Dir(strFolderPath & "\*" & strKeyword & "*", vbDirectory) If Err.Number <> 0 Then MsgBox "エラーが発生しました" & vbCrLf _ & strFolderPath & "\*" & strKeyword & vbCrLf _ & Err.Description, vbExclamation Exit Sub End If Do Until strFolderName = "" If Replace(strFolderName, ".", "") <> "" Then If arrMoveFolders(0, 0) <> Empty Then ReDim Preserve arrMoveFolders(UBound(arrMoveFolders, 1), UBound(arrMoveFolders, 2) + 1) arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & "\" & strFolderName arrMoveFolders(1, UBound(arrMoveFolders, 2)) = strFolderName strFolderName = Dir End If Loop Next If arrMoveFolders(0, 0) = Empty Then MsgBox "該当フォルダがありません" Exit Sub Else If MsgBox("該当フォルダがありました、フォルダを移動しますか", vbOKCancel) <> vbOK Then Exit Sub End If Dim objWSH As Object Set objWSH = CreateObject("WScript.Shell") Dim psCmd As String For i = 0 To UBound(arrMoveFolders, 2) psCmd = "Move-Item " & arrMoveFolders(0, i) & " " & strDestPath & "\" & arrMoveFolders(1, i) objWSH.Run "powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & psCmd, 0, True Next End Sub 以上となります。よろしくお願いいたします。

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

    ベストアンサー

    2

    0

  • excelのVBAで画像の動作をさせるため、プログラムを教えてください。

    添付した画像のような表を作成しています。 ・B２列に名前を入力すると、その隣のC列２列には入力された日付を表示させる ・B２列の入力された名前を消すと、その隣のC列のセルの日付も消える 同じように、 ・F２列に名前を入力すると、その隣のG列２列に入力された日付を表示させる ・F２列の入力された名前を消すと、その隣のG列のセルの日付も消える この場合のプログラムを教えていただきたいです。 お忙しいところ恐縮ですがよろしくお願いいたします。

    質問日時: 2024/01/15 19:24 質問者: ぶんぶんぶんぶんぶんぶんぶん

    解決済

    5

    0

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

    下記のマクロは以前教えて頂いたマクロを少し変更したマクロです。 マクロを実行するとマクロを設定しているブックのサブフォルダ内にある ファイル名「前青紙.xlsx」が開きます。 以前のマクロは Sub 前青紙を開く() On Error Resume Next Workbooks.Open FileName:=ThisWorkbook.Path & "\前審査（ﾌﾀｯﾄ用）\前青紙.xlsx" End Sub となっており、サブフォルダ名を直接「\前審査（ﾌﾗｯﾄ用）\」と指定しておりましたが 「（ﾌﾗｯﾄ用）」の部分が物件により変更になりますので 変更マクロ Sub 前青紙を開く() On Error Resume Next Workbooks.Open FileName:=ThisWorkbook.Path & "\前審査*\前青紙.xlsx" End Sub 「\前審査*\」を変更をしましたが、 マクロが実行できませんでした。 サブフォルダ先をワイルドカードで 「\前審査*\」として マクロを実行できる方法を教えてください。 よろしくお願いいたします。

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

    ベストアンサー

    1

    0

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

    下記のマクロは先日教えて頂いたマクロで 指定セル値の数字が該当した場合に移動元のフォルダが作業ブックに移動できるマクロになっておりますが、 移動元のフォルダ指定のコードが 「strOriginPath = "C:\Users\160931\Desktop\新しいフォルダ\■01_敷地照会回答書"」の場合は上手くマクロが実行されますが 「strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書"」の場合にはエラー表示が出てしまい、 コードの 「FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i)」部分が黄色くなりマクロが実行できません。 解決方法を教えてください。 現状のマクロ Sub 行政回答フォルダ確認() Dim i As Long Dim FSO As Object Dim strKeyword As String Dim strFolderPath As String, strFolderName As String Dim arrMoveFolders As Variant Dim strOriginPath As String, strDestPath As String If MsgBox("フォルダを検索しますか", vbOKCancel) <> vbOK Then Exit Sub Set FSO = CreateObject("Scripting.FileSystemObject") strKeyword = CStr(Sheets("青紙表").Range("R18").Value) strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書" strDestPath = ThisWorkbook.Path If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - Len("\")) ReDim arrMoveFolders(0 To 1, 0 To 0) For i = 0 To 9 strFolderPath = strOriginPath & "\" & i strFolderName = Dir(strFolderPath & "\*" & strKeyword & "*", vbDirectory) Do Until strFolderName = "" If Replace(strFolderName, ".", "") <> "" Then If arrMoveFolders(0, 0) <> Empty Then ReDim Preserve arrMoveFolders(UBound(arrMoveFolders, 1), UBound(arrMoveFolders, 2) + 1) arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & "\" & strFolderName arrMoveFolders(1, UBound(arrMoveFolders, 2)) = strFolderName strFolderName = Dir End If Loop Next If arrMoveFolders(0, 0) = Empty Then MsgBox "該当フォルダがありません" Exit Sub Else If MsgBox("該当フォルダがありました、フォルダを移動しますか", vbOKCancel) <> vbOK Then Exit Sub End If For i = 0 To UBound(arrMoveFolders, 2) FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i) Next End Sub 以上となります。 よろしくお願いいたします。

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

    ベストアンサー

    3

    0

  • Cellsのコードが打てません

    標題の件について、下記画像をご覧ください。 赤字のCellsが打てません。 Cells(i, 1)が、赤字となって打てません。 何か間違っていますでしょうか。 ご存じの方、教えて下さい。 【コード】 Sub Macro() Dim i As Long For i = 1 To 4 Cells(i, 1) Next i End Sub

    質問日時: 2024/01/12 19:15 質問者: aoyama-reiko

    解決済

    6

    0

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

    下記のマクロは先日教えて頂いたマクロで 指定セル値に表示された数字を検索して 指定フォルダ内にあるフォルダ名とが該当した場合に マクロ設定ブックと同じ作業フォルダに移動できます。 例えば 指定セル値R18に「23045906」と表示され 検査フォルダの「6」のフォルダ内にフォルダ名「ABC23045906（回答）」とあり 指定セル「23045906」とフォルダ名の「ABC23045906（回答）」の内 「23045906」とが該当した場合に 作業フォルダにフォルダ毎移動です。 しかし、このマクロを実行すると 画像のエラーメッセージが表示され、コードの 「FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i)」部分が黄色くなり マクロが実行できません。 解決方法を教えてください。 現状のマクロ Sub 行政回答フォルダ確認() Dim i As Long Dim FSO As Object Dim strKeyword As String Dim strFolderPath As String, strFolderName As String Dim arrMoveFolders As Variant Dim strOriginPath As String, strDestPath As String If MsgBox("フォルダを検索しますか", vbOKCancel) <> vbOK Then Exit Sub Set FSO = CreateObject("Scripting.FileSystemObject") strKeyword = CStr(Sheets("青紙表").Range("R18").Value) strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書" strDestPath = " ThisWorkbook.Path" 'ここに作業フォルダのパスを記入 If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - Len("\")) ReDim arrMoveFolders(0 To 1, 0 To 0) For i = 0 To 9 strFolderPath = strOriginPath & "\" & i strFolderName = Dir(strFolderPath & "\*" & strKeyword & "*", vbDirectory) Do Until strFolderName = "" If Replace(strFolderName, ".", "") <> "" Then If arrMoveFolders(0, 0) <> Empty Then ReDim Preserve arrMoveFolders(UBound(arrMoveFolders, 1), UBound(arrMoveFolders, 2) + 1) arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & strFolderName arrMoveFolders(1, UBound(arrMoveFolders, 2)) = strFolderName strFolderName = Dir End If Loop Next If arrMoveFolders(0, 0) = Empty Then MsgBox "該当フォルダがありません" Exit Sub Else If MsgBox("該当フォルダがありました、フォルダを移動しますか", vbOKCancel) <> vbOK Then Exit Sub End If For i = 0 To UBound(arrMoveFolders, 2) FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i) Next End Sub 以上となります。 よろしくお願いいたします

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

    ベストアンサー

    2

    0

  • ゆっくりムービーメーカーのエクセルVBAマクロがうごかない

    ゆっくり亭様が開発してくださったエクセルVBAマクロhttp://tamajimu.sytes.net/archives/935?unapproved=510&moderation-hash=aa2b15d7b29b90cb99eb6507dfb3a20f#comment-510でfindfirsterrorが出てしまい,テキストの流し込みすら出来ません。addSerifuTextBoxが見つかりません、或いはTimelineviewが見つかりませんと出て起動がストップします。タイムライン、アイテム編集ウィンドウ、セリフを打ち込む一番下のバーも追加してシークにした状態で表示していますが、何故か認識されません。ゆっくりムービーメーカーv4.24.03で実行しています。

    質問日時: 2024/01/11 23:08 質問者: atasarrrrrrr

    ベストアンサー

    1

    0

  • コードを直していただきたいです。 以下のコードはネットで拾ったものをほんの少しいじった物なのですが、

    コードを直していただきたいです。 以下のコードはネットで拾ったものをほんの少しいじった物なのですが、フォルダに格納してあるxlsファイルの指定範囲をファイル毎にコピーして別ファイルに貼り付けるというものです。 このコードで問題なく動くのですが、このままだとEXCELを開いた時のシートをコピーするだけなのでシートを指定したいと思っています。 自分ではどうも上手くいかなかったのでどこに何を記載すれば良いか教えて下さい。 指定するシート名は全て同じです。 Sub OpenCSVfile() Dim buf As String Dim Path As String Dim LastRow As Long ' このファイルがあるフォルダのパスを取得 Path = ThisWorkbook.Path 'xlsファイルだけを取ってくる buf = Dir(Path & "\" & "*.xls") '該当するファイルが無くなるまでループ Do While buf <> "" '見つけたファイルを開く Workbooks.Open Path & "\" & buf '開いたxlsファイルのコピーしたい範囲を選択 Range("A1:F5").Copy LastRow = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row '貼り付け If LastRow = 1 And ThisWorkbook.Worksheets(1).Cells(1, 1) = "" Then '最終行が1の時かつセルA1が空欄の時（→シートに何も書かれていない時）は１行目に転記 ThisWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial Else 'A1セルに既に文字が入っている時は最終行+１行目に転記 ThisWorkbook.Worksheets(1).Cells(LastRow + 1, 1).PasteSpecial End If 'xlsファイルを閉じる Workbooks(buf).Close '次のファイルを取得 buf = Dir() Loop End Sub

    質問日時: 2024/01/10 22:50 質問者: 中山あ

    ベストアンサー

    7

    1

  • VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。

    Sh1（入力シート）のI25セルに枚数、K25セルに金額等のデータをSh4（A9引換帳）の G列、Q列等に転記するコードですが、Sh4に表示されません。次のコードのどこに原因があるか教えて下さい。なお、都合上　画像を添付できない旨ご理解ください。 Sub A9引換帳() Dim mRow As Long If Not IsDate(Range("I8").Value) Then Exit Sub ' セルI8の値が日付でない場合、サブルーチンを終了する Select Case Month(Range("I8").Value) ' セルI8の値が日付である場合、その月を取得する ' 以下に各月ごとの処理を記述する Case 4: mRow = 1 ' ４月の場合の処理をする、以下同じ Case 5: mRow = 38 Case 6: mRow = 95 Case 7: mRow = 139 Case 8: mRow = 176 Case 9: mRow = 218 Case 10: mRow = 265 Case 11: mRow = 307 Case 12: mRow = 349 Case 1: mRow = 393 Case 2: mRow = 433 Case 3: mRow = 475 End Select Call Giftbook_main(mRow) End Sub Public Sub Giftbook_main(mRow As Long) Dim sh4 As Worksheet Dim sh1 As Worksheet Dim maxrow As Long Dim Row As Long Dim dicT As Object Dim key1 As Variant Dim key2 As Variant Dim mRow As Long Dim lastRow As Long ' 最後の記録行を追跡する変数 Set sh4 = Worksheets("A9引換帳") Set sh1 = Worksheets("入力シート") Set dicT = CreateObject("Scripting.Dictionary") maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row 　'E伝票番号（一連番号） For Row = 8 To maxrow '８行から最終までの行 key1 = sh4.Cells(Row, "E").Value 'A9引換帳の伝票番号"E"の値の行 dicT(key1) = Row Next '伝票番号を記憶 key2 = sh1.Cells(8, "E").Value dicT(key2) = Row If dicT.exists(key2) = False Then Exit Sub End If If sh1.Cells(8, "L").Value = "" Then MsgBox ("年が未表示です") End If Row = dicT(key1) If sh1.Cells(25, "I").Value = "0" Then 'A9セルの枚数が"0"ならば sh4.Cells(Row + mRow, "F").EntireRow.Delete 'A9引換帳のF列の（Row + mRow）行目を削除する End If 'A9引換帳に転記する。 If sh1.Cells(25, "I").Value <> "0" And sh1.Cells(25, "I").Value <> "0" Then '25行目の"I"列のセルの値が"0"でない場合 ' 最後の記録行を更新 Do While sh4.Cells(lastRow + mRow + 1, "F").Value <> "" '(lastRow + mRow + 1)行目の"F"列のセルの値が空でない間、 lastRow = lastRow + 1 'lastRowの値を1ずつ増やす処理を繰り返す Loop lastRow = lastRow + 1 sh4.Cells(lastRow + mRow, "F").Value = sh1.Cells(12, "E").Value '名前 sh4.Cells(lastRow + mRow, "G").Value = sh1.Cells(25, "I").Value '枚数 sh4.Cells(lastRow + mRow, "D").Value = sh1.Cells(8, "N").Value '日 sh4.Cells(lastRow + mRow, "C").Value = sh1.Cells(8, "M").Value '月 sh4.Cells(lastRow + mRow, "E").Value = sh1.Cells(8, "E").Value '伝票番号 sh4.Cells(lastRow + mRow, "Q").Value = sh1.Cells(25, "K").Value '金額 End If ' 重複チェック Dim exists As Boolean exists = False Dim i As Long For i = 8 To sh4.Cells(Rows.Count, "E").End(xlUp).Row If sh4.Cells(i, "E").Value = sh1.Cells(8, "E").Value Then exists = True Exit For End If Next i If Not exists Then ' データを転記する sh4.Cells(lastRow + 1, "F").Value = sh1.Cells(12, "E").Value '名前 sh4.Cells(lastRow + 1, "G").Value = sh1.Cells(25, "I").Value '枚数 sh4.Cells(lastRow + 1, "D").Value = sh1.Cells(8, "N").Value '日 sh4.Cells(lastRow + 1, "C").Value = sh1.Cells(8, "M").Value '月 sh4.Cells(lastRow + 1, "E").Value = sh1.Cells(8, "E").Value '伝票番号 sh4.Cells(lastRow + 1, "Q").Value = sh1.Cells(25, "K").Value '金額 End If End Sub

    質問日時: 2024/01/08 16:23 質問者: りんごとみかん

    ベストアンサー

    1

    0

  • ファイル名の日付について教えて頂けますかExcel

    下記を実行するとファイル名が2411.pdfとなってしまいます。2312.pdfと出力する方法を教えて頂けますか。 Sub ボタン2_Click() Dim Path As String Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") Worksheets("test").ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=Path & "\" & Format(Now(), "yy") & Format(Month(Date), "mm") - 1 & ".pdf" End Sub

    質問日時: 2024/01/06 11:13 質問者: guito

    ベストアンサー

    3

    1

  • Ａ列に記載されているフォルダを閉じるには

    下記のコードは指定されたフォルダを閉じるコードですが Ａ列に記載されているフォルダのパスが あり、そのフォルダを全て閉じるコード わかる方おしえてくれませんでしょうか 下記のコードはだめでした Dim w For Each w In CreateObject("shell.application").Windows For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If w.LocationName = Cells(i, 1).Value.Title Then w.Quit Next i Next w 下記のコードは Set ff = shell.Namespace("パス名")のパス名を 指定すれば　とじますが、ひとつだけです。 Sub test() Dim wn As Object Dim shell As Object Dim ff As Object Set shell = CreateObject("shell.application") Set ff = shell.Namespace("パス名") For Each wn In shell.Windows If wn.LocationName = ff.Title Then wn.Quit End If Next End Sub

    質問日時: 2024/01/03 12:31 質問者: りんごプリン

    ベストアンサー

    2

    0

  • 【PowerPoint VBA】緑色の文字だけ検知する事は可能でしょうか？

    かなりのページ数のパワーポイントのファイルがあります。(100ページ以上) 緑色の文字を見つけて黒字に修正しなければいけないのですが一括で出来る方法は無いでしょうか？ 複数色使っているので、単純に一括で全部黒字に変更する方法はNGです。 後でチェックするための目印として緑色にしているので、それだけを検知して黒にする必要があります。スライドを順番に目視チェックせずに済む方法を探しています。 同じ色番号で統一した特定の緑色にしてます。 下記がそれぞれ出来るかどうか知りたいです。 ・検知したページにジャンプして自分で黒字に修正する事ができるか ・目視チェックせず、ドキュメント中の全ての緑→黒に一括変換ができるか お詳しい方、よろしくお願いいたします。

    質問日時: 2023/12/28 10:48 質問者: tanapyondai

    解決済

    2

    0

  • excelのVBAについて、以下のコードに追加をお願いいたします。

    （シートモジュールです） Private Sub Worksheet_Change(ByVal Target As Range) '6行未満は対象外 If Target.Row < 6 Then Exit Sub '6,8,10,12,14行・・・以外は対象外 If Target.Column < 6 Then Exit Sub If (Target.Column - 6) Mod 2 <> 0 Then Exit Sub Target.Offset(, 1).Value = Date End Sub 以上のコードを入れてあります。入力箇所の仕様としては、 左側：名前 右側：左側に名前を入力すると、入力された日付が表示される（←ここに作用されるコードになっています） 名前を入力すると日付が表示されるのですが、、、 例　№○問題点 （改善したいこと） №①名前を消しても日付は表示されたまま （名前を消すと日付も消えるようにしたい） №②名前の入力訂正として範囲してdeleteすると、deleteした範囲分の右側に日付が表示される （①と同様に範囲分名前をdeleteしても日付が入力されないようにしたい） №③列まで作用させたいのに、それ以降の列にも同じ作用になる （日付が表示されるのがAM列までにしたい） ※　R6、T6、V6、X6、Z6、AB6、AD6、AF6、AH6、AJ6、AL6列が名前を入力する列 ※　S6、U6、W6、Y6、AA6、AC6、AE6、AG6、AI6、AK6、AM6列が入力された日付が表示される列 お手数ですが、分かる方ご教示をお願いできないでしょうか。 よろしくお願いいたします。

    質問日時: 2023/12/25 10:24 質問者: ぶんぶんぶんぶんぶんぶんぶん

    ベストアンサー

    2

    0

  • VBAのことで質問です

    現在C列に入力するとUserform2が開く仕様になっています その入力した行のD列にUserform2のComboBox１で選んだコメントを転記させたいのですが どのようなコードになりますか？

    質問日時: 2023/12/22 11:23 質問者: kacky76

    ベストアンサー

    6

    0

  • Excelの別ブックの表を1つにまとめたい Book1(会社A)とBook2(会社B)があります。

    Excelの別ブックの表を1つにまとめたい Book1(会社A)とBook2(会社B)があります。 それぞれ表の形は同じです。 イメージのように会社Aの下に会社Bのデータを差し込みたいです。 会社Aの東京店の最終行に会社Bの東京を入れたいです。 上記を各ブックにあるデータ全てに対して同様に処理させたいです。 VBAコードなどで一括処理させる方法をご教授いただけますと幸いです。

    質問日時: 2023/12/19 15:22 質問者: HS83als

    ベストアンサー

    4

    0

  • ExcelのVBAのことで質問です。 以下のコードを入れ、ボタンを押せば作動させると写真のように画面

    ExcelのVBAのことで質問です。 以下のコードを入れ、ボタンを押せば作動させると写真のように画面が表示されてしまいました。 ・セルの検索しても、そのセルまで移動しない状態 ・別のコードを入れたら直るとチャットgptの指示通りのコードをいれても改善しない この場合、どの操作をしたら元に戻せるのか教えていただけないでしょうか、、、 よろしくお願いします。 Sub 列の切り替え() ' 列の表示を切り替える ' 表示する列の範囲を指定 Dim 表示列 As Range Set 表示列 = Union(Range("A:N"), Range("S:V"), Range("AK:AK")) ' 切り替えるシートを指定 Dim 対象シート As Worksheet Set 対象シート = ActiveSheet ' 表示列以外の列を非表示にする Columns.EntireColumn.Hidden = True 表示列.EntireColumn.Hidden = False End Sub Sub 全体表示に戻す() ' 全体の列を表示する ' 切り替えるシートを指定 Dim 対象シート As Worksheet Set 対象シート = ActiveSheet ' シート上の全ての列を表示する Columns.EntireColumn.Hidden = False End Sub

    質問日時: 2023/12/14 16:10 質問者: ぶんぶんぶんぶんぶんぶんぶん

    解決済

    3

    0

  • VBA コード

    超初心者なのですが、アナログで不毛な作業を何とかしたいので勉強中です。 VBAで下記のコードを入力し実行したいのですがご教示頂けませんでしょうか。 例 ①指定範囲（セルA6からA300）を選択しコピー ②指定範囲（セルF2からDU2）のうち最大値の列の6行目から300行目に①を「数値のみ」貼付け 初心者にも分かりやすく解説頂けると幸いです。 宜しくお願い致します。

    質問日時: 2023/12/12 16:24 質問者: _k_s_

    ベストアンサー

    4

    0

  • C列に”済”が入力されたら入力された行が非表示になる。

    sub sample() Dim ii As Long Application.ScreenUpdating = False For ii = 1 To Cells(Rows.CountLarge, "C").End(xlUp).Row If Cells(ii, "C").Value = "済" Then Rows(ii).Hidden = True Next ii Application.ScreenUpdating = True End Sub ↑ 上記のマクロで非表示にはなりますが、”済”と入力してマクロの実行を　その都度そなければ 実行されません、なぜでしょうか？

    質問日時: 2023/12/12 14:05 質問者: やま1130

    解決済

    3

    0

  • お世話になります。 Excel VBAのプログラムについてご教授をお願いいたします。 添付した写真よ

    お世話になります。 Excel VBAのプログラムについてご教授をお願いいたします。 添付した写真ような管理表が例になります。 工程ごとの開始、完了を担当した作業者名を入力すると、入力した日付を表示させるようにしたいのです。 例えば工程1だと、F5セルに工程1を開始した作業者名を入れると、G5セルに作業者名を入力した日付が表示される。 工程数も増やせる、作業者名の入力範囲も上限なしの仕様にしたいのですが、、、 お手数ですがご教示いただけますと幸いです。

    質問日時: 2023/12/12 10:15 質問者: ぶんぶんぶんぶんぶんぶんぶん

    ベストアンサー

    5

    0

  • VBA 別シートの日付けと照合したい

    独学で色々調べながらVBA作成しています。うまくいかないので有識者の方からアドバイス頂ければ幸いです。 ブック:AAA.xlsx シート(左から順に):原本、祝日リスト、1、2～31 ←1ｹ月分のシートです。 シート:祝日リスト内には、セルB1～B20までyyyy/mm/ddの形で、祝日の 日付けが入っています。 下記やりたいことです。 祝日リスト内の、B1～B20までの値を格納する★ シート:1～31までの、セル:E1の値と★を照合する。 シートを回すロジックは理解しています。 シート:祝日リストのB1～B20をfor～next文で回し、シート:1のセルE1と値を照合させようとしましたが上手くいきませんでした。 先に、祝日リスト内の値を格納して、後で照合するのが良いのかと思いました。 よろしくお願い致します。

    質問日時: 2023/12/12 07:52 質問者: shirotantan

    ベストアンサー

    5

    0

  • Excelセルに入力された文字の色を変える方法を教えてください

    セルA1に「あいうえおあいうえおあいうえお」と入力しました。InputBoxに「お」と入力して実行しても、一つの文字しか色が変わりません。対象になるすべての文字の色を変更する方法があるのでしょうか。 Sub test3() Dim str As String Dim cnt As Integer str = InputBox("") cnt = InStr(Cells(1, 1), str) Cells(1, 1).Characters(Start:=cnt, Length:=Len(str)).Font.ColorIndex = 3 End Sub

    質問日時: 2023/12/10 07:42 質問者: 択広

    解決済

    2

    0

  • Ａ列Ｂ列どちらにもあるのを抽出する

    いつもお世話になっております 下記のコードは Ａ列にあってＢ列にないものをＤ列に Ｂ列にあってＡ列にないものをＣ列に のコードを以前いただきました。 Ａ列Ｂ列どちらにもあるのを抽出する にはどうしたよろしいでしょうか わかる方おしえてくれませんでしょうか Sub x() Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary") Dim i As Long, i2 As Long For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Key = Cells(i, 1).Value Dic(Key) = i Next i i2 = 2 For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row Key = Cells(i, 2).Value If Dic.exists(Key) = True Then Dic.Remove (Key) Else Cells(i2, 3).Value = Key i2 = i2 + 1 End If Next i = 2 For Each Key In Dic.keys Cells(i, 4).Value = Key Next Key End Sub

    質問日時: 2023/12/05 22:08 質問者: りんごプリン

    ベストアンサー

    7

    0

  • Excel VBA コードを教えてください。

    やりたいことは、フォルダーの中のファイルのB12の値を一括で アクティブシートのA１から下に順番にコピペをしたいです。 （画像を添付しました） 宜しくお願い致します。

    質問日時: 2023/12/02 22:09 質問者: ボアヒロ

    解決済

    3

    0

  • Ｅxcel VBA ダブルクリックで入力 複数まとめる

    以下の式ように「送」を特定のセル範囲にダブルクリックで入力するようにしているのですが、 同じシート内で、同じようにダブルクリックして「〇」を入力したいセル範囲があります。 この中に含めて（足して）表記するにはどうしたらいいでしょうか。 Else If などの使い方がよく分からず。。 調べながら探り探りでやってしまっており、 内容を変えて追記したところ、あえなくエラーが出てしまいました。 宜しくお願い致します。。 オブジェクトのシートに記載しています ----------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not (Target.Row >= 5 And Target.Row <= 1000 And Target.Column >= 18 And Target.Column <= 22) Then End If Target.Value <> "" Then ' Target.Value = "" Cancel = True Else Target.Value = "送" Cancel = True End If End Sub -----------------

    質問日時: 2023/11/28 00:16 質問者: こんにちはneza

    ベストアンサー

    1

    0

  • ご教授お願いします。#NUM!が解消されません。

    スプレッドシート上での質問です。I2以下下記の数式が入っているのですが何度ためしてもエラーが解消できません。VBAではきちんと稼働していました。どうせくだらない凡ミスだとは思うのですがご指摘のほどよろしくお願いします。 =INDEX($E$3:$E$20,MATCH(SMALL($F$3:$F$20,H2),$F$3:$F$20,0))

    質問日時: 2023/11/25 20:08 質問者: 玄界灘太郎

    解決済

    4

    0

  • 特定文字を入ってるCSVの特定の列を特定のexcelシートに取り込みたいです

    特定のファイル名が "normal-item-stock" を含むCSVのセル内に改行があるため、一気にexcelに取り込みすると、データがぐちゃぐちゃになります。 特定のファイル名が "normal-item-stock" を含むCSVファイルから1列目のデータをExcelのshoplistというシートのA列に取り込み、75列目をB列、82列目をC列に取り込みたいです。 Dim ws As Worksheet Dim SelFile As Variant SelFile = Dir(ThisWorkbook.Path & "\" & "normal-item-stock*.csv") Set ws = Worksheets("shoplist") ' CSV のデータを取り込むシート

    質問日時: 2023/11/25 11:24 質問者: ケンケン123

    解決済

    3

    0

  • Excel VBAでの数値の計算についておしえてください

    VBAを学び始めたのですが、疑問点があります。 添付画像のように、イミディエイトウインドウに、 ＞　? 0.3 = 0.1 + 0.2 とすると ＞　False ＞　? 0.4 = 0.2 + 0.2 とすると ＞　True と出力されます。 なぜこのような違いが出るのでしょうか？ よろしくお願いいたします。

    質問日時: 2023/11/15 19:29 質問者: sho11198

    解決済

    2

    0

  • VBA 二つのブックをうまく扱えないでいます

    次のプログラムですが、ブックが勝手に切り替わってしまいます。 Main, Sub 二つのブックを同時に開き、Mainのアクティブセルをコマンドボタンを押して動かすだけでSubのブックがアクティブになってしまいます。 Rem 標準モジュール Public SubBook As Workbook Public MainBook As Workbook Private Sub Workbook_Open() Set MainBook = ThisWorkbook Dim wsh As Object Set wsh = CreateObject("WScript.Shell") Workbooks.Open wsh.SpecialFolders("Desktop") + "\Sub.xlsm" Set SubBook = ActiveWorkbook UserForm1.Show vbModeless End Sub Private Sub CmdA1_Click() ActiveSheet.Range("A1").Activate End Sub Private Sub CmdG4_Click() ActiveSheet.Range("G4").Activate End Sub Private Sub CmdMain_Click() MainBook.Activate End Sub Private Sub CmdSubActivate_Click() SubBook.Activate End Sub

    質問日時: 2023/11/15 17:17 質問者: payphone

    解決済

    2

    0

  • Excelに保存されているユーザー情報から別ブックの複数シートへ自動転記されるようにしたいです。 ユ

    Excelに保存されているユーザー情報から別ブックの複数シートへ自動転記されるようにしたいです。 ユーザー情報があるマスターファイルの場所は不変にし、読み込む予定です。 ※画像の内容はイメージとして貼ったもので実際の転記したいフォーマットシートはしっかりしたものです。 ユーザー情報のNoを基に別ブックのシートに転記させたいです。 <確認したいこと> 転記させるにあたりどのような方法があるか(ヒューマンエラーなど起こりにくいなど）妙案がありましたらご教授いただけますと幸いです。 また、シートの有無に○をつけたり、チェックボックスを連動させるにはどうしたら良いでしょうか？ 特にイメージだと1つのセルに中国、フランスと入力してますが、これは実現可能でしょうか？ 不可であれば中国、フランスと1つのセルに入力する形を検討します。

    質問日時: 2023/11/15 16:18 質問者: HS83als

    解決済

    2

    0

  • Excel VBAマクロをマスターするのに、どれ位時間掛かりますか？

    Excel VBAマクロをずっと勉強したいと思っています。本とかも持っています。プログラムの書き方の勉強を始めようと思うのですが、身につく迄にどれ位時間掛かるものでしょうか？ご教示の程よろしくお願いします。

    質問日時: 2023/11/14 03:20 質問者: captain_spock

    解決済

    7

    0

  • ExcelのVBAコードを教えて頂けますでしょうか。 例シート2つがあります。 シート1は元データ

    ExcelのVBAコードを教えて頂けますでしょうか。 例シート2つがあります。 シート1は元データ シート2は集計データ 元データの D4セルは東京 k4セルの数量は1 l4セルの数量は6 D5セルは東京 k5セルの数量は10 I5セルの数量は3 D6セルは千葉 k6セルの数量は5 l6セルの数量は1 D7セルは埼玉 k7セルの数量は9 l7セルの数量は9 D8セルは東京 k8セルの数量は5 l8セルの数量は4 D9セルは埼玉 k9セルの数量は6 l9セルの数量は50 最終行まで 集計データの D7セルは東京 k7セルの数量は16 l7セルの数量は13 D8セルは千葉 k8セルの数量は5 l8セルの数量は1 D9セルは埼玉 k9セルの数量は15 l9セルの数量は59 最終行まで Dim ws01 As Worksheet Dim ws02 As Worksheet Dim lastRowSrc As Long Dim lastRowDest As Long Dim I As Long Dim j As Long Dim lRow, mRow, R As Long Dim Hani01, Hani02 As Variant lRow = ws01.Cells(Rows.Count, "D").End(xlUp).Row Set Hani01 = ws01.Range("D4:D" & lRow) m行 = 2 ws02.Cells(mRow, "D") = "" まで実行します R = 0 ～ 11 の場合 Hani02 = Range(ws01.Cells(4, 11 + R), ws01.Cells(lRow, 11 + R)) を設定します。 ws02.Cells(mRow, 11 + R) = WorksheetFunction.SumIf(Hani01, ws02.Cells(mRow, "D"), Hani02) 次のR mRow = mRow + 1 loop

    質問日時: 2023/11/13 17:56 質問者: ekgk

    解決済

    3

    0

  • 月ごとに作成している日報ファイルを、VBAでコピーし日付ごとのシートにしたい

    こんにちは、VBA初心者です。有識者の型アドバイス頂けたら幸いです。 環境はOffice2016です。 行いたいことを下記します。 C:\ABC\1234.xlsx シート名:原本(B3、B4、B5以外には色々と記載あります) セル:B3 → yyyy セル:B4 → mm セル:B5 → dd 1.マクロを実行すると、入力メッセージが表示され、yyyy/mmを入力する。 2.1234.xlsxファイルをコピーし、入力した値よりｍｍ月分.xlsxを作成する。 3.mm月分.xlsxに、1日、2日、3日～　のシート名で月末までのシートを作成する。 4.各シートのB3、B4、B5の値を、入力した値を元に変更する(例:2023 12 3) 5.土日、祝日のシートを、カレンダーもしくは別で定義した日付を元に削除する。 　 別で定義する際は、一年を通して事前に作成しておく。 上記になります。不明点などございましたらコメント頂ければと思います。 よろしくお願いいたします。

    質問日時: 2023/11/11 08:41 質問者: shirotantan

    ベストアンサー

    1

    0

  • VBAコンボボックスで選択した値をシートに転記したい

    教えてください。 B列にはバーコード値、C列には商品名、K列には作成者の氏名を記載します。 ユーザーフォームを作成し、作成者をコンボボックスで表記させております。 作成者コンボボックスの隣に登録ボタンを作成しており、コンボボックスで選択した値を、"sheet1"K列2行目より縦に入力したいです。ただしB列のバーコード値が入力されていないセルは入力しない（バーコード値が入力されているセルまで入力）というマクロです。 ご教示よろしくお願いいたします。

    質問日時: 2023/11/10 14:46 質問者: mokatsu

    ベストアンサー

    3

    0

  • VBAユーザーホームテキストボックスにカーソルを自動で表示したい

    教えてください。 excel VBAで商品管理ソフトを作成しました。一連の流れは完成しましたが、やはりマクロの不慮の改変等が気になるので、ユーザーホームの作成も始めました。 早速の壁が、バーコードリーダーを用いて入庫作業をしますが、メインテキストボックスに入力したら、目的のシートに値は入るものの、カーソルが消えて毎回選択をしないといけません。メインテキストボックスにカーソルが常に表示されるマクロを教えてほしいです。 ちなみに、 ’メインテキストボックス　TabIndex １ Private Sub mc_Exit(ByVal Cancel As MSForms.ReturnBoolean) 　Dim Target As Range 　　If mc.Value = "" Then Exit Sub 　　Set Target = ThisWorkbook.Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) 　　Target.Value = mc 　　mc.Value = "" 　End Sub Private Sub dm_Change()　’ダミーテキストボックス　TabIndex 2 　　mc.SetFocus End Sub Private Sub CommandButton1_Click() Unload UserForm2 よろしくお願いいたします。

    質問日時: 2023/11/10 14:20 質問者: mokatsu

    ベストアンサー

    1

    0

  • マクロのコードについて教えてください

    以下のコードを使用してメーカー毎にシートを指定して振り分けているのですが 指定した分はしっかりと振り分けられるのですが指定していないメーカー名は用意したシートに 全てコピーされてしまいます。 どこが悪いか分からず、直すところを教えてもらえないでしょうか？ Sub 発注書作成() Dim m As String, i As Long Dim arry As Variant m = "メーカー1,メーカー2,メーカー3,メーカー4,メーカー5,メーカー6,メーカー7,メーカー8,メーカー9,メーカー10,メーカー11" arry = Split(m, ",") Worksheets("出荷指図書").Activate If ActiveSheet.AutoFilterMode = False Then Range("C8:C18").AutoFilter End If 'メーカーごとにコピー Application.ScreenUpdating = False For i = 1 To 11 'メーカーシートの数 Worksheets("出荷指図書").Activate ActiveSheet.Range("$C$6:$C$16").AutoFilter Field:=1, Criteria1:=arry(i - 1) Range("D9:G18").Copy Worksheets(arry(i - 1)).Activate Range("A11").PasteSpecial Paste:=xlPasteValues 'お客様名 Worksheets("出荷指図書").Activate Range("D6").Copy Worksheets(arry(i - 1)).Activate Range("E11").PasteSpecial Paste:=xlPasteValues '発注書印刷 If WorksheetFunction.Sum(Range("C11:C20")) <> 0 Then ActiveSheet.PrintPreview 'PrintOut End If Next Worksheets("出荷指図書").Activate ActiveSheet.Range("$C$6:$C$16").AutoFilter Application.ScreenUpdating = True End Sub

    質問日時: 2023/11/10 11:10 質問者: すこやん

    解決済

    2

    0

  • VBAに関して

    以前、VBAでやりたい事を質問しつコードを教えて頂きました。実行した所、型が違うとのエラーで引っ掛かります。初心者のため、色々調べましたがよく分かりません。String=文字列 なので合ってると思うのですが…。 ☆で、2013/12。と入力して、★で引っ掛かかります。改行出来てませんが、下記にコード載せます。 有識者の方、ご指導頂けると幸いです。 宜しくお願い致します。 Sub test() Const fpath As String = "C:\ABC\" Dim wb1 As Workbook, wb2 As Workbook Dim sh1 As Worksheet, sh2 As Worksheet Dim ym As String Dim sdate As Date, edate As Date Dim rng As Range Dim wdate As ☆Date ym = InputBox("年月を yyyy/m の形式で入力してください" & vbCrLf & "例:2023/11") ★If ym = "" Then Exit Sub If IsDate(ym & "\1") = False Then MsgBox "日付エラー" Exit Sub Application.ScreenUpdating = False Application.DisplayAlerts = False sdate = DateValue(ym & "\1") edate = DateSerial(Year(sdate), Month(sdate) + 1, 1) - 1 Set rng = Range("休日") Set wb1 = Workbooks.Open(fpath & "1234.xlsx") wb1.Worksheets("原本").Copy Set wb2 = ActiveWorkbook Set sh1 = wb2.Worksheets("原本") For wdate = sdate To edate If Weekday(wdate, 2) < 6 And WorksheetFunction.CountIf(rng, wdate) = 0 Then sh1.Copy After:=wb2.Worksheets(wb2.Worksheets.Count) Set sh2 = ActiveSheet With sh2.Range("B1").Value = Day(wdate).Name = .Range("B1").Value & "日" End With End If Next wdate wb2.Worksheets(1).Delete wb1.Close wb2.Close SaveChanges:=True, Filename:=fpath & Month(wdate) & "月分.xlsx"Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "処理終了" End Sub

    質問日時: 2023/11/09 20:57 質問者: shirotantan

    ベストアンサー

    2

    0

  • エクセルのマクロのコードについて

    下のコードを使用してオートフィルタからA列を抽出し指定して別シートに貼り付けることが出来ましたが 空白の欄が指定していないシートに張り付いてしまいます。 どこを直していいのかわかりませんので、ご教授お願いいたします Dim m1 As String Dim arry As Variant Dim a2 As Long m1 = "メ1,メ2,メ3,メ4,メ5,メ6,メ7,メ8" arry = Split(m1, ",") Worksheets("発注書リスト").Activate If ActiveSheet.AutoFilterMode = False Then Range("A1:A11").AutoFilter End If For a2 = 1 To 9 Worksheets("発注書リスト").Activate ActiveSheet.Range("$A$2:$A$11").AutoFilter Field:=1, Criteria1:=arry(a2 - 1) Range("B2:B11").Copy Worksheets(arry(a2 - 1)).Activate Range("A11").PasteSpecial Paste:=xlPasteValues Next

    質問日時: 2023/11/09 17:10 質問者: すこやん

    解決済

    1

    0

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

    下記のマクロを実行し、指定サブフォルダ内にあるPDFファイルを作業フォルダ内に移動できるマクロを作成しましたがエラーがでてしまい上手く事項が出来ません解決方法を教えてください。 マクロの内容 移動元フォルダ 「\\nas-sp01\share\確認部\■01_敷地照会回答書」 フォルダ「■01_敷地照会回答書」の中に サブフォルダ 「0」 「1」 「2」 「3」 「4」 「5」 「6」 「7」 「8」 「9」 の各フォルダ10ケがあります。 「0～9」までのフォルダ内には半角英数字の8文字の末尾の数字のPDFファイルが収納されております。 例えば サブフォルダ「0」の中にファイル名「23465900」が収納されております。 マクロ設定ブックのシート名「青紙表」のセル値「R18」にも半角英数字の8文字が 表示されており サブフォルダ「0～9」に収納されているファイルをを検索し、 シート名「青紙表」のセル値「R18」と一致する管理番号のPDFファイルを作業ブック内に移動したいのですが。 マクロを実行し検索を開始し、該当ファイルが無い場合は メッセージ「該当ファイルがありません。」と表示され、マクロが終了 マクロを実行し検索を開始し、該当ファイルがあった場合は メッセージ「該当がありまました。」と表示され、「YES」をクリックすると メッセージ「該当ファイルを移動しますか」と表示され 「YES」をクリックすると指定フォルダから作業フォルダの該当ファイルを移動 メッセージ「該当がありまました。」と表示され、「NO」をクリックすると マクロが終了 例： サブフォルダ「0」の中にファイル名「23465900」が収納されており シート名「青紙表」のセル値「R18」に「23465900」が表示された場合に ファイルを上記の要領で移動 現状のマクロ Sub 行政回答確認() Const BASE_DIR As String = "\\nas-sp01\share\確認部\■01_敷地照会回答書" Const DST_DIR As String = "\\nas-sp01\share\確認部\移動先" Dim namePDF As String: namePDF = ThisWorkbook.Worksheets("青紙表").Range("R18") Dim srcDir As String: srcDir = BASE_DIR & "\" & Right(namePDF, 1) namePDF = namePDF & ".pdf" If Dir(srcDir & "\" & namePDF) = "" Then MsgBox "該当ファイルがありません。", vbExclamation Exit Sub End If If MsgBox("該当がありました。", vbYesNo + vbInformation) = vbNo Then Exit Sub If MsgBox("該当ファイルを移動しますか", vbYesNo + vbInformation) = vbNo Then Exit Sub Name srcDir & "\" & namePDF As DST_DIR & "\" & namePDF End Sub 上記のマクロを実行すると 実行エラー’53’： ファイルが見つかりません。→デバックを開くと コードの内 「Name srcDir & "\" & namePDF As DST_DIR & "\" & namePDF」 が黄色くなってエラーとなっております。 解決方法をよろしくお願いします。

    質問日時: 2023/11/09 11:51 質問者: エクセル小僧

    ベストアンサー

    2

    0

  • VBAについて 集計シートの『A5』にデータシート『I1』からコピーした「2023/10/1」がはい

    VBAについて 集計シートの『A5』にデータシート『I1』からコピーした「2023/10/1」がはいっています。 下記のコードで表示形式を 「2023/10/1」→「2023年10月」 に変換しています。 マクロはExcel起動時に実行される設定ですが 開いた時の状態では、変換されておらず 該当セルをクリックすることで変換されます。 原因、解決策について教えてください。 コード Sheets(“Data”).Select Range(“I1”).Select Selection.copy Seets(“集計”).Select Range(“A5”).Select ActiveSheet.Paste With ActiveSheet .Cells(5,1).NumberFormatLocal = “yyyy年mm月” End With ↑まだまだ勉強中で非効率な書き方になっている かもしれませんがよろしくお願いします。

    質問日時: 2023/11/08 11:14 質問者: おーいんゆ

    ベストアンサー

    4

    0

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

    下記のマクロを実行すると 不要シートを削除し ダイナログが開き、保存先フォルダを指定して 指定セル値名でブックが保存されます。 マクロの機能を残しつつ 保存先だけを下記の内容に変更できる方法を教えてください。 保存先を、このマクロを設定しているカレントフォルダの一つ上のフォルダに保存出来るようにしたいのですが、可能でしょうか。（メッセージ等が非表示） よろしくお願いします。 現状のマクロ Sub 審査保存1() On Error Resume Next Application.DisplayAlerts = False Sheets(Array("F出張費", "F審査(紙)")).Delete Application.DisplayAlerts = True Application.ScreenUpdating = False Const folder As String = "\\nas-sp01\share\確認部\電子申請 関連\" Dim newName As Variant Dim initName As String initName = folder & Range("U1").Value newName = Application.GetSaveAsFilename(InitialFileName:=initName, FileFilter:="Excel マクロ有効ブック(*.xlsm), *.xlsm") If newName = False Then Exit Sub Dim WS As Worksheet Dim TargetCheck As String Dim List As Variant Dim i As Long Dim Chk As Boolean List = Array("休日") For Each WS In Worksheets Chk = False If WS.Visible = False Then For i = 0 To UBound(List) If WS.Name = List(i) Then Chk = True Exit For End If Next i If Chk = False Then TargetCheck = TargetCheck & WS.Name & vbCrLf Application.DisplayAlerts = False WS.Delete Application.DisplayAlerts = True End If End If Next WS ThisWorkbook.SaveAs newName, xlOpenXMLWorkbookMacroEnabled Application.ScreenUpdating = True Application.Quit With ThisWorkbook .Saved = True .Close False End With End Sub 以上です。 よろしくお願いします。

    質問日時: 2023/11/08 10:31 質問者: エクセル小僧

    ベストアンサー

    3

    0

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

Q質問する（無料）

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

【Visual Basic（VBA）】のコラム/記事一覧  もっと見る
コンピューターによる高速度に演算、判別、照合をする情報処理が可能になったことで私たちの便利な暮らしは支えられています。コンピューターを形作るOS、ソフトウェア、運用するためのネットワーク、サーバーなどに関してはこちらを参照してください。
カテゴリ一覧
ページトップ ページトップ

新しく質問する

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報