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

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

回答数

気になる

Excel VBA ファイル取得についてフォルダの中に、ファイル名“会議“を含むファイルが1つまた

Excel VBA ファイル取得についてフォルダの中に、ファイル名“会議“を含むファイルが1つまたは複数あります。《実行内容》 Dim fullPath As String, myFile As String ※fullPath 省略 myFile = Dir(fullPath & "¥" & "*会議*") “会議“ファイルが複数ある場合、ファイルを昇順に並べた時に一番上に来るファイル1つを取得したいです。どのようにしたら良いか教えて頂けると幸いです。宜しくお願い致します。

質問日時: 2022/10/12 01:18 質問者: m0m0-wan

ベストアンサー

9

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

Excelのマクロについて教えてください。マクロ Sub 保存() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("記載方法")).Delete Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Application.Dialogs(xlDialogSaveAs).Show Arg1:="\" & Range("P2").Value, Arg2:=xlOpenXMLWorkbookMacroEnabled Worksheets("提出シート").Activate Range("B1", "C28").Select myBook = ThisWorkbook.Path Application.DisplayAlerts = False Sheets("提出シート").Shapes("紙").Visible = False ' Sheets("提出シート").Shapes("紙保存").Visible = False ' Sheets("提出シート").Shapes("注意").Visible = False ' ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("P2").Value & "●.xlsx", FileFormat:=xlOpenXMLWorkbook Application.Quit With ThisWorkbook .Saved = True Application.DisplayAlerts = True .Close False End With End Sub があります。このマクロを実行すると不要なシートを削除指定セル値「P2」名でマクロ有効ブックと一般のExcelブックの2つのファイルが出来上がります。このマクロにハイパーリンク「=HYPERLINK("mailto:"&L33&"?cc="&L34&"&subject="&L35&"&body="&L36&"","メールを作成する")」を追加し、マクロが実行された最後にこのハイパーリンクを実行する方法を教えてください。よろしくお願いいたします。

質問日時: 2022/10/11 12:55 質問者: エクセル小僧

ベストアンサー

1

0
【再投稿】VBAで動作しなくて困っています

VBAのworksheet_changeで J1にONの値が入っているときのみ B列に文字が入力された場合 D列に時間を入力しそれ以外は D列とE列に 3桁か4桁の文字を入力した場合コロンを自動入力し時刻を入力するようにしましたが＞J1にONの値が入っているときのみ B列に文字が入力された場合 D列に時間を入力しの方だけうまく動かないので教えてくださいソースコード Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$J$1" If Range("J1").Value = "ON" Then If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, 2).Value = Time Application.EnableEvents = True Else End If End Select Dim myTime As Long If Intersect(Target, Range("D3:E1100")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target On Error GoTo EH If .Value <> "" Then If IsNumeric(.Value) And .Value > 0 Then If .Value - Int(.Value) = 0 And .Value Mod 100 < 60 Then myTime = .Value Application.EnableEvents = False .Value = TimeSerial(Int(myTime / 100), myTime Mod 100, 0) .NumberFormatLocal = "[h]:mm" Application.EnableEvents = True Exit Sub End If End If End If EH: Application.EnableEvents = False .ClearContents .Select Application.EnableEvents = True End With End Sub

質問日時: 2022/10/11 11:05 質問者: shim0x

ベストアンサー

2

0
VBAのトグルボタンでのマクロについて質問です

onのときに B列に文字を入力した際 D列に入力した時刻が入力され offのときにonの機能がoffになり D列とE列に3桁もしくは4桁の数字を打った際にコロンを省略して時刻が入力されるマクロを作りましたが onの場合は問題ないですが offの場合入力がうまくいかない為教えてください具体的にはtargetのオブジェクトがないか入力しても00:00になってしまいますソースコード Private Sub ToggleButton1_Click() With ToggleButton1 If .Value Then 'トグルボタンONの処理 .Caption = "自動入力　ON" Application.EnableEvents = True MsgBox "自動入力が　ONになりました", vbInformation Else 'トグルボタンOFFの処理 .Caption = "自動入力　OFF" Application.EnableEvents = False MsgBox "自動入力が　OFFになりました", vbInformation If Intersect(Target, Range("D:E")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If .Value <> "" Then If IsNumeric(.Value) Then If .Value < 2400 And .Value Mod 100 < 60 Then Application.EnableEvents = False .Value = TimeSerial(Int(.Value / 100), .Value Mod 100, 0) .NumberFormatLocal = "h:mm" Application.EnableEvents = True Else MsgBox "入力値が不正です" .Select .ClearContents End If End If End If End With End If End With End Sub 一応裏で常駐させているイベントのコードも記しておきます Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, 2).Value = Time Application.EnableEvents = True End Sub よろしくお願いします！

質問日時: 2022/10/10 17:23 質問者: shim0x

ベストアンサー

3

1
VBA初心者です。

VBA初心者です。エクセルのVBAを用いて宛先毎に指定の添付を送りたいと思います。さらに送信されたかわかるようにエクセルのB列に送信状況がわかるようにしたいのですがどんな文法をいれてよいのかわかりません。教えていただけると大変助かります。下記のどごにどのようにすればよいでしょうか。 Sub outlook() Dim oApp Dim Wm_ITEM Dim Wm_TO Set oApp = GetObject(, "Outlook.Application") Dim folder As String Dim FileName As String Dim row As Long Dim shname As String row = 2 shname = "提供票送付事業所一覧" Do Until row = 150 Set Wm_ITEM = oApp.CreateItem(0) Wm_TO = "" WS_OutLk = "" If ThisWorkbook.Sheets(shname).Cells(row, 1) <> "" Then Wm_ITEM.To = ThisWorkbook.Sheets(shname).Cells(row, 5) Wm_ITEM.CC = ThisWorkbook.Sheets(shname).Cells(row, 6) Wm_ITEM.Subject = ThisWorkbook.Sheets(shname).Cells(row, 7) Wm_ITEM.Body = ThisWorkbook.Sheets(shname).Cells(row, 3) & _ ThisWorkbook.Sheets(shname).Cells(row, 4) Wm_ITEM.Body = Wm_ITEM.Body _ & vbCrLf _ & ThisWorkbook.Sheets(shname).Cells(row, 8) folder = ThisWorkbook.Sheets(shname).Cells(row, 9).Value FileName = ThisWorkbook.Sheets(shname).Cells(row, 10).Value Wm_ITEM.Attachments.Add folder & "\" & FileName Wm_ITEM.display Wm_ITEM.Save 　 Wm_ITEM.Send End If row = row + 1 Loop MsgBox "完了" End Sub

質問日時: 2022/10/10 11:52 質問者: tutituti1010

解決済

2

0
VBAで重複データを確認したい

sheet1の、”B3”に年、”D3”に月、”F3”に日、そして”F5”に担当者名が入力されます。他にも様々な項目がsheet1にあり、それらを日計として別のsheet2に転記します。（sheet1に設置した入力ボタンを押すと、sheet2に転記されます） sheet2には、各担当者が日計を入力し、下記のように日々新しいデータが蓄積されていきます。（sheet2は、A列に年、B列に月、C列に日、D列に担当者名となっています）　　年　　月　　日　担当　・・・その他項目色々・・・ 2022　 10　　5　　A 2022　 10　　5　　B 2022　 10　　5　　C 2022　 10　　9　　A 2022　 10　　9　　C 現状ですと、新たにsheet1からsheet2への登録の際、同一年月日かつ同一担当のデータが既にある場合でもsheet2の最終行に追加されてしまいます。同じ年月日で同じ担当のデータがある場合、「同じデータがあります」等、何らかのメッセージボックスで警告したいのですが、複数の一致データ（年、月、日、担当者）の検索方法がよくわかりません。お知恵を頂けると幸いです。

質問日時: 2022/10/07 16:24 質問者: 88suihou88

ベストアンサー

5

0
セルの値からファイルを複数作りたい２

こちらで質問して解決したのですが、新たな課題が出てきてしまいました。・前回の質問セルの値からファイルを複数作ることができました。既存のマクロエクセルブックがあり、ファイルには複数のシートが入っています。（50シート）複数のシートの中で、別ブックで保管したいシートのR1セルには、ファイル名を入れています。 R1セルに入っている値総務部_aaaaa.xlsx 総務部_abbbb.xlsx 経理部_accaa.xlsx 営業部_ddddd.xlsx R1セルにはいっている値をファイル名にして区分けする下記コードを教えていただきました。・今回の質問既存のマクロエクセルブックには sheet1とsheet2があり、こちらも複数シート作成の際にシートをコピーして結果すべてのシートに保管したいです。下記 Sub Q_13175734() Dim Dic, v, p As String Dim i As Long, j As Long Const b = "\/:;*?""<>|" ' 以下二行の「CO」の文字を下記にあるように修正のこと！！！ Set Dic = CO("Scripting.Dictionary") p = CO("WScript.Shell").SpecialFolders("Desktop") & "\TEST\" If Dir(p, 16) = "" Then MkDir p For i = 1 To Worksheets.Count v = Worksheets(i).Range("R1").Text If Right(v, 5) = ".xlsx" Then v = Left(v, Len(v) - 5) For j = 1 To Len(b) v = Replace(v, Mid(b, j, 1), "X") Next j If v <> "" Then If Dic.Exists(v) Then Dic(v) = Dic(v) & "|" & Worksheets(i).Name Else Dic.Add v, Worksheets(i).Name End If End If Next i Application.ScreenUpdating = False Application.DisplayAlerts = False For Each v In Dic Worksheets(Split(Dic(v), "|")).Copy With ActiveWorkbook .SaveAs p & v & ".xlsx" .Close False End With Next v Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub ご教授いただければ幸いです。宜しくお願い致します。

質問日時: 2022/10/07 15:54 質問者: hayaya0604

ベストアンサー

3

0
複数シート一括作成後に、特定範囲の数式は値で貼り付けしたい

下記はフォーマットというシートをコピーして、管理者というシートのＡ列のセル名から一括でシート名にしていくＶＢＡです。 Sub 管理者() Dim Data As Worksheet Dim ws As Worksheet Dim i As Long Dim LastRow As Long Set Data = Sheets("管理者") Data.Select LastRow = Data.Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = False For i = 2 To LastRow Sheets("フォーマット").Copy Before:=Data ActiveSheet.Name = Data.Cells(i, 2) Set ws = ActiveSheet ws.Range("B1") = Data.Cells(i, 1).Value ws.Range("B2") = Data.Cells(i, 2).Value ws.Range("B3") = Data.Cells(i, 3).Value ws.Range("D1") = Data.Cells(i, 4).Value ws.Range("D2") = Data.Cells(i, 5).Value ws.Range("D3") = Data.Cells(i, 6).Value ws.Range("D4") = Data.Cells(i, 7).Value Next i Application.ScreenUpdating = True End Sub フォーマットというシートには数式が入っています。シート作成後に、下記範囲の数式は値で貼り付けしたいのですがどのようにすればよいでしょうか。値で貼り付けしたいセル範囲 A1:P4 A44:B46 A48:B50 ご教授いただければ幸いです。宜しくお願い致します。

質問日時: 2022/10/07 11:18 質問者: hayaya0604

ベストアンサー

3

0
VBAで実行時エラー'424' オブジェクトが必要ですと出る

お世話になります。下記のようなコードでsearchがgenre.worksheets(1)のA列になかった場合、そのA列の最終行の次に追加するようにしたいのですが、VBAで実行時エラー'424'が出て困っています。エラーメッセージで検索して、setをつけると解決するという記事が多くあるのを知ったのですが、デバッグで黄色くなっているのは genre.Worksheets(1).Range("A" & genre.Worksheets(1).Cells(Row.Count, "A").End(xlUp).Row + 1).Select の部分です。解決策ご教示お願いします。コードが怪しいと思われる１ブロックになっているのと、インデントがされておらず見づらくてすみません。 For lNo = 6 To 9 search = da.Worksheets(1).Cells(fi, sNo).Value If search = 0 Then Exit For End If Set sRange = genre.Worksheets(1).Range("A2:A" & genre.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row).Find(what:=search) If sRange Is Nothing Then genre.Worksheets(1).Range("A" & genre.Worksheets(1).Cells(Row.Count, "A").End(xlUp).Row + 1).Select ActiveCell.FormulaR1C1 = search Else ThisWorkbook.Worksheets(1).Cells(fi + 2, tNo).Value = sRange.Offset(0, lNo).Value End If Debug.Print (sRange) tNo = tNo + 1 Next lNo

質問日時: 2022/10/07 09:25 質問者: ひまわりおれお

ベストアンサー

2

0
追記する列を増やしたい 2つのデータを検索・照合して元データにないデータを下記マクロで商品名を追記し

追記する列を増やしたい 2つのデータを検索・照合して元データにないデータを下記マクロで商品名を追記しています。今回、図にあるJ列のコードもA列へ追記したいのですがどう記述したら良いかわかりません。助けてください。　Dim I, L, lRow, mRow As Long Dim CheckCells As Range With ActiveSheet lRow = .Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を取得します。（元データ） mRow = .Cells(Rows.Count, "K").End(xlUp).Row 'K列の最終行を取得します。（追記対象データ） L = lRow + 1 '追記行を求める（E列最終行＋１） For I = 2 To mRow '追記対象データ分繰り返す（最終行まで） Set CheckCells = .Range("E:E").Find(.Cells(I, "K")) 'E列全てに対してN列の追記対象データを1件ずつ照合する。 If CheckCells Is Nothing Then 'データが無ければ追記対象データをE列の最終行に追記します .Cells(L, "E") = .Cells(I, "K") L = L + 1 'E列の追記行に＋１を加算する。 End If Next I End With

質問日時: 2022/10/05 10:50 質問者: momo_2123

ベストアンサー

9

0
最終行の指定について教えてください。複数シートを1シートへまとめる下記マクロでは各シートの6行目を

最終行の指定について教えてください。複数シートを1シートへまとめる下記マクロでは各シートの6行目をコピーしていました。しかし図のように6行目からA列最終行までコピーする必要があり変更したいのですができません。助けてください。 Dim A For i = 2 To Sheets.Count '7つ目のシートから最終シートまでをループ 'まとめシートの最終セルを取得 Set A = Sheets("matome").Cells(Rows.Count, "A").End(xlUp) 'データ部分のみを、まとめシートにコピー Sheets(i).Rows(6).Copy A.Offset(1, 0) Next

質問日時: 2022/10/04 18:37 質問者: momo_2123

ベストアンサー

1

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

マクロコード Sub ファイル削除() Application.DisplayAlerts = False On Error Resume Next Worksheets(Array("10", "100", "300", "500")).Delete Dim myName As String, myBook As String myName = ThisWorkbook.FullName myBook = ThisWorkbook.Path ActiveWorkbook.SaveAs Filename:=myBook & "\" & Range("Z1").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook With ThisWorkbook .ChangeFileAccess xlReadOnly Kill myName If Workbooks.Count <= 1 Then Application.Quit .Saved = True .Close False Application.DisplayAlerts = True End With End Sub があります。このマクロを実行すると不要シートを削除し指定セル値でファイル形式を「XLSX」にて保存し元のファイルを削除できるマクロです。このマクロを実行したタイミングで指定シート「青紙表」指定セル値「R33」にセルが移動してマクロが終了できる方法を教えてください。よろしくお願いいたします。

質問日時: 2022/10/04 10:48 質問者: エクセル小僧

ベストアンサー

1

0
エクセル VBAで複数セル選択時エラーになる問題

お世話になります。いろいろなところでお力を受けて、以下のようなVBAを作ったのですが、このような記述ですと、複数セルを選択してペーストするとエラーが出てしまい一括処理ができなくて困っております。 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("F:F,K:K")) Is Nothing Then With Application .EnableEvents = False With Target .Value = Application.Substitute(.Value, "A", "B") .Value = Application.Substitute(.Value, "C", "D") .Value = Application.Substitute(.Value, "E", "F") .Value = Application.Substitute(.Value, "G", "H") .Value = Application.Substitute(.Value, "H", "I") If Target.Value = "J" Then Target.Interior.Color = vbYellow If Target.Value = "K" Then Target.Interior.Color = 3329330 .Value = Application.Substitute(.Value, "J", "CR") .Value = Application.Substitute(.Value, "K", "CR") .Value = Application.Substitute(.Value, "M", "CR") End With .EnableEvents = True End With End If End Sub 複数セルを選択して処理をするためには、どのような記述にしたらよいでしょうか？ご指導宜しくお願いいたします。

質問日時: 2022/10/04 02:40 質問者: gou72118

ベストアンサー

3

0
シートを選択して、１つのPDFにしたいのですが。

チェックボックスで選択た複数のシートを１つのｐｄｆにできるようにしたいのですが、ご指導いただければ幸いです。シートは「1月講座室予約表」から「12月講座室予約表」まであります。 CheckBox1は1月講座室予約表、CheckBox2は2月講座室予約表・・・に対応させたいです。次のコードを書いてみたのですが、「Sheets(Array(MySht(i))).Select」のところが「インデックスが有効範囲にありません」と表示されてしまいます。 Private Sub CommandButton1_Click() Dim MySht(11) As Variant For i = 1 To 12 If Me.Controls("CheckBox" & i).Value = True Then MySht(i) = i&"月講座室予約表" End If Next i Sheets(Array(MySht(i))).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ FileName:=ActiveWorkbook.Path & "¥" & "予約表" & Format(Date, "yyyymmdd") & ".pdf" End Sub

質問日時: 2022/10/03 20:18 質問者: monsaru2

解決済

5

1
excel vbaでselenium basic

いつも大変お世話になってますタイトルの件、excel vbaでselenium basicを使用したWebスクレイピングを作成していますその中で、やっかいなWebDriverの更新を自動化すべくコードを書いていますが、 Edgeを使う指定をしたときだけ正常に動かず困っています。下記の手順を実施してます ①SeleniumBasicをインストール ②マクロで自動更新のコードを実行　→添付画像のところでエラーが出ます　　見たところ、デフォルトインストールされるedgedriver.exeのバージョン情報が引っ張れないようです edgedriver.exeを個別にダウンロードしてきてコピペしたのちにコードを実行すると自動更新のコードが正常に動くようになりますこの、デフォルトインストール段階から、正常にコードが動くようにするにはどうしたら良いでしょうかお詳しい方いらっしゃいましたら、ご教示いただけますでしょうかちなみに、chromeで実行すると、デフォルトインストール状態からでも正常に自動更新のコードは動きます

質問日時: 2022/10/02 12:35 質問者: Enrichおじ

解決済

3

0
<excel vba>selenium basicのWebDriverの自動更新のエラーについて

はじめまして excel vba でedgeを使ったWebスクレイピングのコードを書いていますスクレイピング自体のコードは問題ないんですが、多人数での使用を考えているため、WebDriverの自動アップデートを組み込んだんですが、うまくいかず躓いています自動アプデを紹介しているところを参考に、.basファイルをインポートして、実行すると、添付の画像のところで止まってしまいますエラーは、”オブジェクトは、このプロパティまたはメソッドをサポートしていません。”　です Driverpathはドキュメントフォルダが指定されており、そこに解凍されたedgedriver.exeがあることは確認していますどなたか、原因と思われることについてわかる方がいらっしゃいましたら、ご教示いただけないでしょうか。他に必要な情報があれば、仰っていただければお出しします使用OS:Win11 21H2 使用Exc：Home & Business 2019

質問日時: 2022/10/01 17:07 質問者: Enrichおじ

ベストアンサー

1

0
ExcelVBAで他のExcelVBAを実行

ExcelVBAで他のExcelファイルに設定されているモジュールを実行させたいです。以前職場の同僚にそういったやり方があると聞きました。ググってもなかなかそういう記事が見つかりません。やり方をご存知の方、教えてください。

質問日時: 2022/10/01 14:55 質問者: うざこ

解決済

2

0
【至急】当方初心者です。マクロについて知恵をお貸しください。 ★したい動作 ①リストE列2行目か

【至急】当方初心者です。マクロについて知恵をお貸しください。 ★したい動作 ①リストE列2行目から（1行目は項目名の為）、【残したい文字列】を含まない行の削除 ②リストc列2行目から（1行目は項目名）、【消したい文字列】を含む行を削除上記、①のみで組んだところ動作確認が出来ましたが、続けて②の動作を行いたい場合、どのように繋げるとよろしいのでしょうか。

質問日時: 2022/09/29 18:56 質問者: rioxx

ベストアンサー

4

0
【Excel VBA】自動メール送信の機能追加

現在、下記のコードでsheetの更新をし保存で閉じた際自動でメール送信をするマクロで約半年運用しております。今回、以下の指定した範囲以外を更新した時は「別アドレス」「別メール」を同じ様に自動送信したいと思っております。※件名、本文も別（現範囲）　S4:S200 （追加範囲）M4:M200 追記可能であればご教授頂ければと思っております。よろしくお願い致します。 ---------------------------------------------------------------------------- Option Explicit Private SavedFlg As Boolean '//保存の変数 Private ChangeFlg As Boolean '//範囲変更の変数 '標準モジュールに別途「 Public myShFlg() As Boolean 」記述あり Private Sub Workbook_Open() Dim i As Long ReDim myShFlg(1 To ThisWorkbook.Sheets.Count) 'シート数の準備を下記「Workbook_BeforeClose」にする For i = 1 To ThisWorkbook.Sheets.Count myShFlg(i) = False '念のために全てFalseをセット Next i End Sub '範囲指定フラグ Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'If Intersect(Target, Sh.Range("S1")) Is Nothing Then Exit Sub '【メンテナンス用】 If Intersect(Target, Sh.Range("S4:S200")) Is Nothing Then Exit Sub '//指定範囲　日計表処理が「済」 ChangeFlg = True '//範囲外ならMail送信しないフラグ myShFlg(Sh.Index) = True '//更新されたシートのフラグをTrueに End Sub '保存フラグ Private Sub Workbook_AfterSave(ByVal Success As Boolean) SavedFlg = True End Sub 'ファイルを閉じ保存した時に更新シート別にメールを送信 Private Sub Workbook_BeforeClose(Cancel As Boolean) Const olMailItem = 0 Const olFormatPlain = 1 If Not Saved Then Select Case MsgBox("'" & ThisWorkbook.Name & "' の変更内容を保存しますか？", vbExclamation + vbYesNoCancel) Case vbYes Application.EnableEvents = False ThisWorkbook.Save Application.EnableEvents = True SavedFlg = True Case vbNo ThisWorkbook.Saved = True Case vbCancel Cancel = True Exit Sub End Select End If If Not SavedFlg Then Exit Sub If Not ChangeFlg Then Exit Sub '//シートごとのアドレス設定＿複数Add設定は「;」で区切る。 'myShFlg(〇)はタブ左からのNo. 'sheet1 If myShFlg(1) Then Call myMailSend("メールアドレス", Worksheets(1).Name) 'sheet2 If myShFlg(2) Then Call myMailSend("メールアドレス", Worksheets(2).Name) 'sheet3 If myShFlg(3) Then Call myMailSend("メールアドレス", Worksheets(3).Name) 　　'実際は24タブあり Exit Sub End Sub 続く・・・

質問日時: 2022/09/29 12:53 質問者: まさまちゃ

ベストアンサー

5

0
vb.net どうしてイコールにならないのでしょうか

Dim dtNow As DateTime Dim dtAlarm As DateTime dtNow = DateTime.Now Dim strAl As String = dtNow.ToString("yyyy/MM/dd HH:mm:ss") dtAlarm = DateTime.Parse(strAl) If dtNow = dtAlarm Then ～

質問日時: 2022/09/29 12:21 質問者: payphone

ベストアンサー

4

1
【再投稿】VBAのシフト表でバグが出て困っています

ExcelのVBAでシフト表を作っていますが、バグが出て困っています毎月21日～翌月20日までのシフト表を作成し、 VBAで日付を更新した上でコピーするマクロを作成しましたが画像1枚目のように 2か月ごとに19日までしか表示されないバグが出てしまいどうしても原因がわからないので教えてください。毎月C2~AF2まで21日～翌20日と表記されればokです C2　には　日付 D2～AF2までは　D2=C2+DAY(1), E2=D2+DAY(1)....にように左のセルに対して+DAY(1)を入れています O1 には =C2 Q1 には DATE(YEAR($O$1),MONTH($O$1)+1,DAY(20)) がそれぞれ入っていますソースコードも記しておきますので教えてください ------------------------------------ Sub sheetcopy() Dim OldSheet As Worksheet Worksheets(Worksheets.Count).Select Set OldSheet = ActiveSheet ActiveSheet.Copy After:=Worksheets(Worksheets.Count) atama = DateAdd("m", 1, Range("C2").Value) Range("C2").Value = atama ActiveSheet.Name = Year(Range("Q1").Value) & "年" & Month(Range("Q1").Value) & "月" Dim be As Date Dim af As Date be = Range("O1").Value af = Range("Q1").Value non = af - be non = non + 4 Do While non < 34 Columns(non).Hidden = True non = non + 1 Loop Range("C4:AG6").ClearContents Range("C7:AG9").ClearContents Range("C10:AG12").ClearContents Range("C13:AG40").ClearContents Range("C13:AG40").Interior.Color = xlNone End Sub ---------------------------------------------- 前回の質問で D2セルに　=IFS(C2="","",C2+1>$Q$1,"",1,C2+1) として、右方にフィルコピーしておき C2に1か月後の日付を入力するという回答をいただきましたがうまくいきませんでした D2セルに=IFS(C2="","",C2+1>$Q$1,"",1,C2+1)を入力しても反映されませんでした

質問日時: 2022/09/24 08:29 質問者: shim0x

ベストアンサー

3

0
Selenium.ChromeDriverの使い方について

次がWEBページのソースの一部です。：　<div id = "output"> <table> <tbody> ' <tr> <th style = "width:120px;">項目1</th> <td> ①</td> </tr> <tr> <th style = "width:120px;">項目2</th> <td> ②</td> </tr> <tr> <th style = "width:120px;">項目3</th> <td> ③</td> </tr> この中で①②③の文字列を取得したいです。現在は次の方法で①②③を取得していますが、別の方法で目的の要素だけ取得したいのでご教示いただきたいです。 Temp = Driver.PageSource 'ページ全体を取得　　　　　　　　　　　　　　　※（高速処理の必要上上ここが不適当と判断しています） Work = Split(Temp, "<td> ") '目的情報直前の記述でSplit A = Mid(Work(4), 1, InStr(Work(4), "<") - 1) '① B = Mid(Work(5), 1, InStr(Work(5), "<") - 1) '② C = Mid(Work(6), 1, InStr(Work(6), "<") - 1) '③ 現在自分で調べて次のことはできています。 Cnt1 = Driver.FindElementsByTag("table").Count: Debug.Print Cnt1 '<----- 1 を表示 Cnt2 = Driver.FindElementsByTag("tbody").Count: Debug.Print Cnt2 '<----- 1 を表示 Cnt3 = Driver.FindElementsByTag("td").Count: Debug.Print Cnt3 '<----- 3 を表示でも Txt = Driver.FindElementsByTag("td")(1).Text '<----- Errorとなります。よろしくお願いいたします。

質問日時: 2022/09/22 06:43 質問者: 物好きじいちゃん

解決済

7

0
Excel VBA リンク更新について A、B、Cのファイルかあります。（Aファイルのリンク元Bフ

Excel VBA リンク更新について A、B、Cのファイルかあります。（Aファイルのリンク元Bファイル、 Bファイルのリンク元Cファイル） AファイルにてVBA実行《実行内容》 Bファイルを開く Bファイルにてリンク元Cファイルを値の更新 Aファイルにてリンク元Bファイルを値の更新どのようにしたら良いか教えて頂けると幸いです。宜しくお願い致します。

質問日時: 2022/09/21 13:40 質問者: m0m0-wan

ベストアンサー

1

0
VBAでのフルパスの取得

https://liclog.net/getwindowtext-function-vba-api/#:~:text=VBA%E3%81%A7%E3%82%A6%E3%82%A3%E3%83%B3%E3%83%89%E3%82%A6%E5%90%8D%E3%82%92,%E5%8F%96%E5%BE%97%E3%81%99%E3%82%8B%E5%BF%85%E8%A6%81%E3%81%8C%E3%81%82%E3%82%8A%E3%81%BE%E3%81%99%E3%80%82 に載っていたコードでExcelファイルを特定しました。できればローカルに保存したのでフルパスが特定したいです。 AccessVBAで実行したのですが、 Excelのファイルは特定できないでしょうか？ご存知の方、教えてください。

質問日時: 2022/09/20 22:51 質問者: うざこ

解決済

1

0
2つの条件が一致したら一覧へコピーしたい。左から４番目以降のシート名にコードが入ったシートを全て、

2つの条件が一致したら一覧へコピーしたい。左から４番目以降のシート名にコードが入ったシートを全て、２番目のシート名「一覧」へコピーしたい。コピーの条件はA列のコードとE列の品名が一致した場合、コードが入ったシートのC列の値を一覧のF列へD列の値をG列へコピーしたい。どのようなコードを書けばよいか教えてください。

質問日時: 2022/09/20 19:41 質問者: momo_2123

ベストアンサー

5

0
動かなくなってしまった古いVBAを動くようにしたい

VBAの質問です。 20年前に作られたファイルの更新をしたいです。ファイルの場所およびファイル名を取得する箇所で、該当のボタンを押すとファイル選択のエクスプローラーが起動するはずなのですが、パソコンを入れ替えたら何も起きなくなってしまいました。（エラーも出ません）コードの該当箇所はここだと思うのですが、どこかを書き換えれば動くようになるでしょうか。なお、一般公開してはまずい情報は含まれていないと判断してアップロード致しましたが、万一含まれていましたらご指摘下さい。質問を取り消します。 Private Sub CommandButton2_Click() Dim tOpenFileName As OpenFileName With tOpenFileName '構造体のサイズを設定 .lStructSize = LenB(tOpenFileName) '親ウィンドウのハンドルを指定 '.hwndOwner = Me.hWnd 'アプリケーションのインスタンスのハンドルを指定 '.hInstance = App.hInstance '不要の時　0& 'ファイルパターンを設定（複数指定する場合は続いて記入） .lpstrFilter = "Excelファイル(*.XLS)" & vbNullChar & "*.XLS" '優先的に表示させるフィルタのインデックス .nFilterIndex = 1 'ファイル名の内容を初期化 .lpstrFile = String$(256, Chr$(0)) ' "*.txt" & String$(256, Chr$(0)) '同バイト数 .nMaxFile = 256 'ファイル名を受取るバッファの設定(Nullで埋めておく） .lpstrFileTitle = String$(256, Chr$(0)) '同バイト数 .nMaxFileTitle = 256 'デフォルトのフォルダ名の設定 .lpstrInitialDir = "C:\" 'ダイアログのキャプション名 .lpstrTitle = "ファイルを開く" 'flagsの動作の設定 .flags = OFN_EXPLORER Or OFN_PATHMUSTEXIST _ Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY End With 'ダイアログの表示 If GetOpenFileName(tOpenFileName) = 0 Then 'キャンセルボタンを押した場合（クローズ・エラーも） strFileName = "" Exit Sub Else '開くボタンを押した場合（ファイル名を取得） Sheet5.Cells(7, "M") = Left$(tOpenFileName.lpstrFile, InStr(tOpenFileName.lpstrFile, vbNullChar) - 1) Sheet5.Cells(7, "N") = Left$(tOpenFileName.lpstrFileTitle, InStr(tOpenFileName.lpstrFileTitle, vbNullChar) - 1) End If End Sub

質問日時: 2022/09/20 13:57 質問者: bari_saku

解決済

8

1
複数のシートを一つのシートにまとめたい左から3番目以降のシートのE列のセルに⚪︎が入っている行を抽

複数のシートを一つのシートにまとめたい左から3番目以降のシートのE列のセルに⚪︎が入っている行を抽出して左から2番目のシートに並べたいがVBAだとどのようなコードになるか教えてください。

質問日時: 2022/09/18 18:42 質問者: momo_2123

ベストアンサー

2

0
配列にしたセル範囲でのコメントがあるかどうかを取得するコードの書き方

いつも大変お世話になっております。下記コードでコメントを取得する際のコードがわかりません。オブジェクトが必要ですのエラーが出ます。ご教示お願い致します。 Dim n As Long, a As Variant, dmr As Integer a =ListObjects("テーブル1").DataBodyRange dmr = UBound(a, 1) For n = 1 To dmr If a(n, 1) = DateValue(Me.TextBox1.Text) Then If TypeName(a(n, 3).comment) = "Comment" Then ←ココ　※　「オブジェクトが必要です。」 Msgbox a(n, 3).comment.Text End If End if Next

質問日時: 2022/09/17 05:09 質問者: 太郎です

ベストアンサー

2

0
vba メモリ節約

EXCEL 2016 32bitです。とあるexcel fileで私自身の動作は問題ないのですが他の利用ユーザーが同じファイルでクラッシュ多発しています。オートメーションエラーや、何も表示されず突然ファイルが閉じるなど発生するのですがステップインで実行したら正常に終了します。法則性がないと言うか、いろんな場所でクラッシュするので軽くしたいのですがメモリの節約方法を教えていただけないでしょうか私が作ったファイルに関連する情報ではなく幅広くあげてほしいいです。ちなみにフォームで入力をしています。現状私がやっている方法 set wb = nothing　などでオブジェクトの解放標準モジュールの独自の関数を出来るだけ作って、codeを長くしないように小分けで関数を実行する他のファイルを開く前にDoEvents 以下は前回私がした質問です。 ”vbModelessをやめれば、解決するのですが”とありますが・・・最近やめてもクラッシュが連続で起きました。 https://oshiete.goo.ne.jp/qa/13132576.html

質問日時: 2022/09/16 21:45 質問者: ひろみch

解決済

3

0
VBA Bookの表示、非表示

下記に表示・非表示のモジュールを2つ書きました。例えばこれをUserformでコマンドボタン作って実行できるようにしたとします。 1つ目 ’≪ブックを非表示にする≫ Private Sub CommandButton1_Click() Dim wb As Workbook, BN As String For Each ws In Workbooks cnt = cnt + 1 Next ws If cnt = 1 Then Application.Visible = False Else BN = ThisWorkbook.Name Application.Windows(BN).Visible = False End If End Sub ２つ目 '≪ブックを表示する≫ Private Sub CommandButton2_Click() Dim wb As Workbook, BN As String For Each ws In Workbooks cnt = cnt + 1 Next ws If cnt = 1 Then Application.Visible = True Else BN = ThisWorkbook.Name Application.Windows(BN).Visible = True End If End Sub 次に、新規に他のエクセルファイルを開きます。何らかのエクセルファイルでもいいです。その後に上記の非表示にするモジュールを実行します。残ったエクセルファイルを閉じてみてください。 Thisworkbookの方に閉じるメッセージが出ます。（なんででしょうか？）何らかの工夫で後で開いたエクセルファイルを閉じるようにできませんか？わかる方、お願致します。

質問日時: 2022/09/16 20:44 質問者: ちょいよ

ベストアンサー

1

1
Excel VBA フォルダ存在チェックについて Aフォルダの中にBフォルダがあります。 IF構文を

Excel VBA フォルダ存在チェックについて Aフォルダの中にBフォルダがあります。 IF構文を使って、Bフォルダの中にサブフォルダがある場合と、ない場合の実行内容を分けたいです。どのようにしたら良いか教えて頂けると幸いです。宜しくお願い致します。

質問日時: 2022/09/16 19:36 質問者: m0m0-wan

ベストアンサー

3

0
エクセルのマクロについて質問があります。現在は下記のマクロでエクセル表を保存しています ThisW

エクセルのマクロについて質問があります。現在は下記のマクロでエクセル表を保存しています ThisWorkbook.SaveAs "Y:\①生産表\" & "生産計画" & Format(Now, "yyyy-mmdd-hhmm") & ".xls", 56 もう一つフォルダを追加したいのですが調べてもわかりませんでした。教えて頂けないでしょうか。鋳物部門フォルダ→生産表フォルダ→生産計画xls 宜しくお願いします

質問日時: 2022/09/16 11:22 質問者: ミンミンだよ

ベストアンサー

2

0
顧客ごとに違う点検案内を作成するマクロ

ファイルの構成 3シートの構成 sheet1：データ用シート　A1セルは氏名を入力、2行目は項目行でA2：氏名　B2：点検数　C2：A作業点検日　D2：A作業点検時間　E2：B作業点検日　F2：A作業点検時間です。 sheet2　A.B両方の点検を行う場合の点検案内用シート　 sheet3　Aの点検のみ行う場合の点検案内用シート sheet2,sheet3はともにsheet1のA1セルを検索値としてVLOOKUP関数で点検日時を引っ張ってきています。sheet1のA1セルに氏名（A3以降）を順番に入力（またはコピペ）し、点検数が2個の人の場合はsheet2の案内分（sheet2のみ）を計算式を消して新規保存し（ファイル名はsheet1のA1セル値）点検数が1個の場合は同様にsheet3を新規人数分全部保存します。保存先フォルダはC:\Users\PCuser\Desktop\点検で氏名数は31ですが今後増える予定です。日程が月ごとにに変わり、そのたびに全員分当該フォルダに格納しているため一度に格納するマクロ記述を教えてください。

質問日時: 2022/09/16 05:34 質問者: ラップ6614

解決済

4

0
配列の勉強をしています。使用する変数の意味、検索条件の書き方が難しいです。

Sheet2に1051行、28列のデータがあります。1列、3列には全部の行にデータがあります。 Sheet2のデータからIf分を使って抽出されたデータをSheet1の転記しています。 Sheet1は1，2行目に表題、発行日などがあり、3行目が項目にいなって4行目から抽出データが入るようになっています。行は1000行まであります。下記のコードを配列に書き換えるとどのようになるか教えてください。今のままで特に時間がかかるわけではないのですが、変数の意味、配列でのIf文の書き方が知りたいです。 Sub KousinMeibo() Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") Set wS3 = Worksheets("Sheet3") wS2.Select Dim cnt Dim rw Dim i, j, l, m As String i = "前回 " j = "札付 /" l = "～ /" m = "/" wS1.Unprotect With wS1 wS1.Range("B2").Value = wS3.Range("I15").Value wS1.Range("K1").Value = wS3.Range("I16").Value wS1.Range("H1").Value = Date rw = 4 .Range("B4:N1300,P4:T1300").ClearContents Application.EnableEvents = False Application.ScreenUpdating = False For cnt = 2 To 1051 If wS2.Range("W" & cnt).Value = wS3.Range("I15").Value _ Or wS2.Range("N" & cnt).Value = 1 And wS2.Range("K" & cnt).Value < Worksheets("表紙").Range("I16").Value Then Application.StatusBar = cnt & "回目の処理をしています..." .Range("B" & rw).Value = wS2.Range("Q" & cnt).Value + vbLf + wS2.Range("C" & cnt).Value .Range("C" & rw).Value = wS2.Range("E" & cnt).Value + vbLf + wS2.Range("D" & cnt).Value _ + vbLf + wS2.Range("F" & cnt).Value .Range("D" & rw).Value = wS2.Range("J" & cnt).Value .Range("E" & rw).Value = wS2.Range("L" & cnt).Value .Range("F" & rw).Value = wS2.Range("W" & cnt).Value .Range("G" & rw).Value = wS2.Range("X" & cnt).Value .Range("H" & rw).Value = m .Range("I" & rw).Value = i & wS2.Range("N" & cnt).Value .Range("J" & rw).Value = wS3.Range("I16").Value .Range("K" & rw).Value = l .Range("M" & rw).Value = j .Range("N" & rw).Value = wS2.Range("AB" & cnt).Value .Range("Q" & rw).Value = wS2.Range("C" & cnt).Value .Range("R" & rw).Value = wS2.Range("D" & cnt).Value .Range("S" & rw).Value = wS2.Range("K" & cnt).Value .Range("T" & rw).Value = wS2.Range("X" & cnt).Value rw = rw + 1 End If Next End With Application.EnableEvents = True Application.ScreenUpdating = True Application.Goto wS1.Range("B1") Application.StatusBar = False wS1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

質問日時: 2022/09/15 14:06 質問者: mossa_2007

ベストアンサー

2

0
範囲を指定して別シートにコピペ

シート「元シート」のA3セル以降の最終行までを基準としてK列までの範囲(空白のセルを含みます)をコピーして、シート「貼りつけシート」のA列の最終行から一つ下の空いてるセルに値で貼り付けたいです。お詳しい方、宜しくお願い致します。

質問日時: 2022/09/15 07:32 質問者: さわ子

ベストアンサー

2

0
指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける（再質問）

小職の操作あやまりで当該質問が終了してしまったため、再度ご質問させていただきます。＜既質問内容＞月ごとの顧客データファイルが「顧客データ」フォルダに格納されています。フォルダー内のファイル名は「顧客データ（2022年〇月分）」です。１行目は項目行でA列は顧客コード、B列は申込日で50列程あります。毎月初に前月分データが格納された後、前月から３カ月分（９月であれば6～8月）のデータファイルを統合した後、第一順位：A列、第二順位：B列で並べ替えを行い、貼り付け用のファイル（ファイル名：〇月契約管理表）のsheet1に貼り付けます。貼り付け場所はB列以降に貼り付けます（A列は番号を振るため計算式が入ってますので貼り付けない）。月が明けたら前3か月分指定フォルダー内から取り出し、指定のファイルに貼り付けするマクロ記述は可能でしょうか。 tatsumaru77様よりご回答いただき下記ULRにアップしていただきありがとうございます。　 https://ideone.com/KZVjPD 自身の環境下で設定後、うまく作動はしました。ただ補足のご質問に対する私の回答が悪かったためか、〇月契約管理表に貼り付けられたのは顧客データのA・B列は貼り付いておりますが他の列は貼り付いていないため、色々試してみましたができませんでした。すべてを〇月契約管理表に貼り付けるためにはどの部分を修正すればよいかお教えいただけないでしょうか。

質問日時: 2022/09/14 22:51 質問者: ラップ6614

ベストアンサー

4

0
先頭と末尾を指定して連続した数字を入力

2つのセルに先頭と末尾の数字を指定すると O列の最終行から一つ下の行(空のセル)にその間の数字も含めて入力できるようにしたいです。例えば、O列にはO3まで値が入力されています。 P2のセルに数字の「1」、P3のセルに数字の「10」を入力した場合。マクロを実行するとO4セルに「1」、O5セルに「2」、、、O13セルに「10」と入力することはできるのでしょうか？お詳しい方宜しくお願い致します。

質問日時: 2022/09/14 13:12 質問者: さわ子

ベストアンサー

1

1
ＶBA This Workbookモジュールを別ファイルにコピーする方法

お詳しい方　　御教授をお願いします。相談事項エクスポートした　VBAプログラムが格納されたThis Workbookを指定したフォルダに格納されている全エクセルファイルにコピーを行いたい。しかし、下記のコードで実行を行おうとすると This Work book1というモジュールが作成されコピーがうまくいかないどのようにコードを変更すればいいのか、アドバイスを頂けないでしょうか。コード Sub モジュール追加釦_Click() 'インポートされるブックが存在するフォルダ Const TARGET_XLS_FOLDER = "変更予定のフォルダURL" 'インポートするモジュールが存在するフォルダ Const TARGET_MODULE_FOLDER = "This Workbook　保管フォルダURL" Dim fso As FileSystemObject Set fso = New FileSystemObject 'ブックが存在するフォルダを取得する Dim xlsfolder As Folder Set xlsfolder = fso.GetFolder(TARGET_XLS_FOLDER) Dim xlsfile As File 'モジュールが存在するフォルダを取得する Dim mdlfolder As Folder Set mdlfolder = fso.GetFolder(TARGET_MODULE_FOLDER) Dim mdlfile As File '対象フォルダ内のファイルをループさせる For Each xlsfile In xlsfolder.Files '拡張子がエクセルのマクロ有効ブックの場合、このブックは対象外とする If fso.GetExtensionName(xlsfile.Path) = "xlsm" And xlsfile.Path <> ThisWorkbook.Path Then Dim wb As Workbook Set wb = Workbooks.Open(xlsfile.Path) 'モジュールファイルをループさせる For Each mdlfile In mdlfolder.Files If fso.GetExtensionName(mdlfile.Path) = "bas" _ Or fso.GetExtensionName(mdlfile.Path) = "frm" _ Or fso.GetExtensionName(mdlfile.Path) = "cls" Then '既存のモジュールがあれば削除 Call removeObj(wb, fso.GetBaseName(mdlfile)) '新しいモジュールを追加する Call wb.VBProject.VBComponents.Import(mdlfile) End If Next 'ブックを保存して閉じる wb.Save wb.Close End If Next 'オブジェクトを開放 Set fso = Nothing End Sub

質問日時: 2022/09/14 01:51 質問者: kazunoko1689

解決済

1

1
ExcelのVBAでシフト表を作っていますが、バグが出て困っています

毎月21日～翌月20日までのシフト表を作成し、 VBAで日付を更新した上でコピーするマクロを作成しましたが 2か月ごとに19日までしか表示されないバグが出てしまいどうしても原因がわからないので教えてください。毎月C2~AG2まで21日～翌20日と表記されればokです C2　には　日付 O1 には =C2 Q1 には DATE(YEAR($O$1),MONTH($O$1)+1,DAY(20)) がそれぞれ入っています ------------------------------------ Sub sheetcopy() Dim OldSheet As Worksheet Worksheets(Worksheets.Count).Select Set OldSheet = ActiveSheet ActiveSheet.Copy After:=Worksheets(Worksheets.Count) atama = DateAdd("m", 1, Range("C2").Value) Range("C2").Value = atama ActiveSheet.Name = Year(Range("Q1").Value) & "年" & Month(Range("Q1").Value) & "月" Dim be As Date Dim af As Date be = Range("O1").Value af = Range("Q1").Value non = af - be non = non + 4 Do While non < 34 Columns(non).Hidden = True non = non + 1 Loop Range("C4:AG6").ClearContents Range("C7:AG9").ClearContents Range("C10:AG12").ClearContents Range("C13:AG40").ClearContents Range("C13:AG40").Interior.Color = xlNone End Sub

質問日時: 2022/09/13 11:33 質問者: shim0x

ベストアンサー

2

0
コマンドプロンプトでフォルダ内（デスクトップ）の複数PDFファイルの１ページ目だけを印刷したい

こんばんは。複数PDFファイルの１ページ目だけをコマンドプロンプトで印刷する方法をネット検索し見つけたのですが、１ページ目だけを指定して印刷する方法をご教示ください。 Option Explicit Dim f, gf, so, ws Set so = CreateObject("Scripting.FileSystemObject") Set gf = so.GetFolder(".") Set ws =CreateObject("WScript.Shell") For Each f In gf.Files If LCase(so.GetExtensionName(f.Name)) = "pdf" Then ws.Run "AcroRd32.exe /t " & gf & "\" & f.Name End If Next Set gf = Nothing Set so = Nothing Set ws = Nothing MsgBox("Finished!")

質問日時: 2022/09/11 23:33 質問者: tommygoo1

解決済

1

1
データを製品別に集計

sheet1にあるデータの集計結果をsheet2に出したいです。実際、製品の種類は複数、データ数は5000以上あります。製品の銘柄と倉庫は固定です。画像では違いますが製品の並びは昇順にしたいです。これをVBAで行いたいです。お詳しい方宜しくお願いいたします。

質問日時: 2022/09/11 21:17 質問者: さわ子

ベストアンサー

3

0
入力と同時に桁数を詰める

Ｄ列に入力装置（バーコードスキャナ）で読み込んだ9桁から10桁の数字を右から3桁を切りたいです。これを入力と同時に行いたいです。入力装置で読み込むと自動で下のセルに移動します、そういう仕様になっています。このバーコードの読み込みを連続で行います。入力した値が 123456789の場合、123456 1234567890の場合、1234567 となれば良いです。 E列にはVLOOKUPでD列を検索値としています。始めは、K列に入力してD列に、=LEFT(K1, LEN(K1)-3)と関数を入れましたがうまくいきません。 D列に入力されたと同時に右から3桁を切り、E列にVLOOKUPされた値を都度確認したいです。何か良い方法はありませんでしょうか？宜しくお願いいたします。

質問日時: 2022/09/11 20:23 質問者: さわ子

ベストアンサー

3

0
指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける

月ごとの顧客データファイルが「顧客データ」フォルダに格納されています。フォルダー内のファイル名は「顧客データ（2022年〇月分）」です。１行目は項目行でA列は顧客コード、B列は申込日で50列程あります。毎月初に前月分データが格納された後、前月から３カ月分（９月であれば6～8月）のデータファイルを統合した後、第一順位：A列、第二順位：B列で並べ替えを行い、貼り付け用のファイル（ファイル名：〇月契約管理表）のsheet1に貼り付けます。貼り付け場所はB列以降に貼り付けます（A列は番号を振るため計算式が入ってますので貼り付けない）。月が明けたら前3か月分指定フォルダー内から取り出し、指定のファイルに貼り付けするマクロ記述は可能でしょうか。

質問日時: 2022/09/10 07:55 質問者: ラップ6614

ベストアンサー

3

0
モードレスでユーザーフォームが開け（表示）ません。

いつもお世話になっております。エクセルVBAであれこれやっており，なんとか思うことができるようになりましたが，またストップしてしまいました。いくつかユーザーフォームを設定し，メインのユーザーフォームを， Private Sub Workbook_Open() Dim Excelver As String Worksheets("マスター").Activate Excelver = Application.Version 'MsgBox "Excelバージョン：" & Excelver If Excelver = 15 Then 'エクセル2013 Const setRefFile As String = "C:\Program Files\Microsoft Office 15\Root\Office15\MSOUTL.OLB" ActiveWorkbook.VBProject.References.AddFromFile setRefFile End If If Excelver = 16 Then 'エクセル2019 Const setRefFile1 As String = "C:\Program Files (x86)\Microsoft Office\root\Office16\MSOUTL.OLB" ActiveWorkbook.VBProject.References.AddFromFile setRefFile1 End If ActiveWindow.WindowState = xlMaximized 受付_後処理.Show End Sub のなかで開くようにしてます。メインのユーザーフォームのプロパティで　ShowModal--False にしてモードレスにすると，Bookを開くさいにユーザーフォームが表示されません。　ShowModal--True 原因が分かりません。手動でユーザーフォーム開けば問題ないのですが，　原因がおわかりでしたら，ご教示ください。

質問日時: 2022/09/09 11:05 質問者: mabo52

解決済

4

0
vbaを早くしたい

Sheet1に現在のの会員情報Sheet2に新規の申し込みの会員情報があります。 Sheet1のB列の氏名とSheet2のG列の氏名を照合して一致するものをSheet1の右側に必要な事項を転記したい。Sheet1に2000件ほどSheet2に1000件ほどのデータがあります。添付のvbaで一応結果が得られますが3分弱の時間がかかってしまいます。早く処理できる方法をご教示ください。 Sub 全体重複確認 Dim i As Long, n As Long, j As Long, C As Range, wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") j = wS1.Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To wS1.Cells(Rows.Count, 2).End(xlUp).Row Set C = wS2.Columns(7).Find(what:=wS1.Cells(i, 2), LookIn:=xlValues, lookat:=xlWhole) If Not C Is Nothing Then n = C.Row wS1.Cells(i, 7).Value = wS2.Cells(n, 1).Value wS1.Cells(i, 8).Value = wS2.Cells(n, 7).Value wS1.Cells(i, 9).Value = wS2.Cells(n, 12).Value wS1.Cells(i, 10).Resize(1, 2).Value = wS2.Cells(n, 15).Resize(1, 2).Value wS1.Cells(i, 12).Value = wS2.Cells(n, 10).Value End If Next i MsgBox "重複確認しました" & vbCrLf & "OKで重複分だけを表示します。" Worksheets("Sheet1").Select ActiveSheet.Range("$A$1:$J$" & j).AutoFilter Field:=8, Criteria1:="<>" End Sub

質問日時: 2022/09/09 10:58 質問者: mossa_2007

ベストアンサー

5

0
Accessフォームで全レコードを指定のExcelのセルへ転送し印刷する方法について

Accessフォームで入力したレコードを指定のエクセルのセルへ転送し印刷できるようにしました。「Excelへ出力」ボタンをクリックすると、一件分のレコードのみ転送され印刷できましたが、残りのレコードも印刷できるようにしたいですが直し方がわからないため、コードの修正箇所を教えていただきたいです。分かる方がいましたらご教授ください。コードは以下の通りです。よろしくお願いします。 Private Sub Excelへ出力_Click() Dim WB1 As Workbook Dim WS1 As Worksheet Dim D8 As String On Error GoTo ProcessError MsgBox "本日の体力測定結果を印刷します" 'ファイルopen Workbooks.Open filename:="C:\体力測定\TEST.xlsx" Set WB1 = Workbooks("TEST.xlsx") Set WS1 = WB1.Worksheets(1) WS1.Cells(3, 1).Value = Me.部課CD.Value WS1.Cells(3, 2).Value = Me.職場.Value WS1.Cells(3, 3).Value = Me.氏名コード.Value WS1.Cells(3, 4).Value = Me.氏名.Value WS1.Cells(3, 5).Value = Me.身長.Value 'ファイル保存 D8 = "C:\体力測定\" & "_" & Format(CStr(Now), "yyyymmddhhmmss") & ".xlsx" WS1.Activate Activesheet.PrintOut ActiveWorkbook.SaveAs D8 ActiveWorkbook.Close SaveChanges:=False Exit Sub ProcessError: MsgBox "エラー番号:" & Err.Number & vbCrLf & _ "エラーの種類:" & Err.Description, vbExclamation Exit Sub End Sub

質問日時: 2022/09/08 18:23 質問者: Access苦手

解決済

2

0
シート削除のマクロで「deleteメソッドは失敗しました」となります。助けてください！ Sub 不要

シート削除のマクロで「deleteメソッドは失敗しました」となります。助けてください！ Sub 不要シート削除() Dim WS As Worksheet Dim Target As String Target = "利用表" For Each WS In Worksheets If InStr(WS.Name, Target) <> 1 Then 　　　　　WS.Activate Application.DisplayAlerts = False WS.Delete Application.DisplayAlerts = True End If Next WS End Sub

質問日時: 2022/09/08 16:41 質問者: momo_2123

ベストアンサー

6

0
入力ボックスが繰り返しポップアップして止まらない。下記コードでファイル名の変更をしたいのですが、変

入力ボックスが繰り返しポップアップして止まらない。下記コードでファイル名の変更をしたいのですが、変更前の文字を入力ボックスにするにはどう変えたら良いかおわかりの方教えてください。 Sub ファイル名変換2() Dim FileP As String 'フォルダ選択のダイアログボックスを開く Application.FileDialog(msoFileDialogFolderPicker).Show '選択したフォルダのパス名を取得 FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) 'ファイル名の変換 Dim FileA As String '選んだフォルダの拡張子xlsを含むファイルを返す FileA = Dir(FileP & "\*.xls*") 'フォルダ内のファイルがなくなるまで繰り返す Do While FileA <> "" 'ファイル名の変換 Dim Str1 As String, Str2 As String '変換前の対象文字列 Str1 = InputBox("変更前を入力", "ファイル名変更", "")'←任意で変える部分 '変換後の文字列 Str2 = "" '←任意で変える部分 '各ファイルのStr1部分をStr2に変換する Name FileP & "\" & FileA As (Replace(FileP & "\" & FileA, Str1, Str2)) 'Dirの指定をなくす FileA = Dir() Loop End Sub

質問日時: 2022/09/08 11:27 質問者: momo_2123

ベストアンサー

1

0
複数セルに〇印をつけるマクロ

現在下記のマクロで複数セルに一度に〇印（楕円）をつける作業をしています。やりたいこと ①セルの幅に合わせて〇をつける（楕円ではなく円）・・・縦長のセルのため ②結合したセルには一つの〇（円）が描かれるようにする（現在はセル数分〇印が描かれてしまう）。以上です。どなたか記述を修正していただけませんでしょうか。 Sub 　選択した複数セルに〇印() For Each r In Selection Set s = ActiveSheet.Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) s.Fill.Visible = msoFalse s.IncrementLeft 0 s.IncrementTop 0 With s.Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 .Weight = 1.5 End With Next End Sub

質問日時: 2022/09/07 05:33 質問者: ラップ6614

ベストアンサー

4

0
Excel のユーザー定義関数でソルバーが動作しない

多くの変数がある中での最大最小値計算にソルバーを利用しています．各変数およびその制約条件が縦に並び，数字違いが横に並んでいます． 1 列毎に最大値・最小値を計算したいのですが，ソルバーですと 1 条件毎 (1 列毎) に条件をハンドで入れ直さねばならないですよね... そこでユーザー定義関数内にソルバーを組み込み，各変数とその制約条件はユーザー関数の引数として指定という形にして，行全体に数式をコピーすれば結果を求められるようにしたいです． VBA は全くの素人で，まずは簡単なものでと思い以下のようなユーザー定義関数を作成しましたが，エラーこそ出ないものの変数セル (D6, D7) が初期値のままで全く変化しません (ソルバーが動作している気配無し，関数の戻り値も初期値によって計算された値)．何が問題かアドバイスをお願いします． ------------------------------------------------------------------------------ Function Test1(Target As Range) As Double SolverReset SolverAdd CellRef:="$D$6", Relation:=1, FormulaText:="$D$2" SolverAdd CellRef:="$D$6", Relation:=3, FormulaText:="$D$3" SolverAdd CellRef:="$D$7", Relation:=1, FormulaText:="$D$4" SolverAdd CellRef:="$D$7", Relation:=3, FormulaText:="$D$5" SolverOk SetCell:=Target.Address, MaxMinVal:=1, ValueOf:=0, ByChange:="$D$6:$D$7", Engine:=1, EngineDesc:="GRG Nonlinear" SolverSolve UserFinish:=True SolverFinish KeepFinal:=1 Test1 = Target.Value End Function ------------------------------------------------------------------------------ D9 セルにこのユーザー定義関数を入力 (=Test1(D10))， D10 セルには D6, D7 を使用した数式が入っています．

質問日時: 2022/09/05 19:51 質問者: 束人

ベストアンサー

1

0

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

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

質問する（無料）

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

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

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

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

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

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