回答数
気になる
-
VBA指定行削除
下記のVBAで ・a列の最終行までの重複しているその行全体を削除 ・b列の最終行までの「NG」と「中断」がある行全体を削除 したいのですがうまくいきません。どこにどのようにしたらできるでしょうか? a列のの重複だけ削除されていて他の行が残ったりします。 詳しい方教えて下さい。お願いします。 Sub 一覧() Dim lastRow As Long Dim sourceRange As Range Dim destinationRange As Range Dim firstUnderscorePos As Integer Dim lastUnderscorePos As Integer Dim valueBeforeUnderscore As String Dim valueAfterUnderscore As String ' シート1で最終行を取得 lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row ' シート1でA2から最終行までの範囲を選択 Set sourceRange = Sheets("Sheet1").Range("A2:A" & lastRow) ' シート2のA1セルから貼り付け Set destinationRange = Sheets("Sheet2").Range("A1") ' 最初の"_"部分までをA列に、最後の"_"部分のあとをB列に貼り付け For Each cell In sourceRange valueBeforeUnderscore = "" valueAfterUnderscore = "" ' "_"の位置を取得 firstUnderscorePos = InStr(1, cell.value, "_") lastUnderscorePos = InStrRev(cell.value, "_") ' "_"が存在する場合 If firstUnderscorePos > 0 And lastUnderscorePos > 0 Then ' "_"の前の部分を取得 valueBeforeUnderscore = Mid(cell.value, 1, firstUnderscorePos - 1) ' "_"の後の部分を取得 valueAfterUnderscore = Mid(cell.value, lastUnderscorePos + 1) End If ' ".xlsx"を削除 valueBeforeUnderscore = Replace(valueBeforeUnderscore, ".xlsx", "") valueAfterUnderscore = Replace(valueAfterUnderscore, ".xlsx", "") ' A列に貼り付け destinationRange.value = valueBeforeUnderscore ' B列に貼り付け destinationRange.Offset(0, 1).value = valueAfterUnderscore ' 次の行に移動 Set destinationRange = destinationRange.Offset(1, 0) Next cell End Sub
質問日時: 2024/05/26 10:02 質問者: ケイ0000
回答受付中
2
1
-
VBA一覧取得 再投稿
下記のVBAでエクセル名の取得できるところまでは作成できています。 このVBAで一覧にしてそのシート上でそのエクセルファイルを開きたいのですが できるでしょうか?エクセル名とパスを取得する感じできるでしょうか? 詳しい方教えてください。 最終的には名前で検索をかけて2つのファイルを開きたいと思っています。 ご意見よろしくお願いします Sub GetExcelFileNames() Dim folderPath As String Dim fileName As String Dim row As Long ' フォルダーのパスを指定 folderPath = "C:\YourFolderPath\" ' ここに対象フォルダーのパスを記入 ' フォルダーのパスがバックスラッシュで終わっているか確認 If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" End If ' 初期設定 fileName = Dir(folderPath & "*.xls*") ' フォルダー内のExcelファイルを取得 row = 1 ' アクティブシートをクリア Cells.Clear ' ファイル名を取得してシートに書き込む Do While fileName <> "" Cells(row, 1).Value = fileName row = row + 1 fileName = Dir Loop ' 終了メッセージ MsgBox "ファイル名の取得が完了しました。", vbInformation End Sub
質問日時: 2024/05/25 12:28 質問者: ケイ0000
回答受付中
1
0
-
エクセルVBAについて
エクセルファイルをダイヤログを表示させて名前を付けて保存したいのですが、 以下のコ-ド、' A列の最終行の数字を取得 lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Valueの部分で型が一致しませんとエラーメッセージが出ます。 エラーメッセージを出さずに保存するにはどこを修正すればよいのでしょうか? どなたかご教示願います。 よろしくお願いいたします。 Sub ファイル保存() Dim folderPath As String Dim fileName As String Dim dateStr As String Dim c3Content As String Dim d3Content As String Dim e3Content As String Dim f3Content As String Dim customName As String Dim lastRow As Long Dim formattedF3Content As String Dim formattedCombinedContent As String ' 保存先フォルダのパスをダイアログで選択 folderPath = "C:\Users\t-tai\OneDrive\デスクトップ\図番" ' A列の最終行の数字を取得 lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Value ' 今日の日付を文字列に変換 dateStr = Format(Date, "yyyymmdd") ' 各セルの内容を取得 c3Content = ThisWorkbook.Sheets(1).Range("C3").Value d3Content = ThisWorkbook.Sheets(1).Range("D3").Value e3Content = ThisWorkbook.Sheets(1).Range("E3").Value f3Content = ThisWorkbook.Sheets(1).Range("F3").Value ' F3セルの内容をフォーマット(4桁の内容があるが左から2行目の後に-を挿入) If Len(f3Content) >= 4 Then formattedF3Content = Left(f3Content, 2) & "-" & Mid(f3Content, 3, 2) Else MsgBox "F3セルの内容が正しくありません。4桁の内容を含めてください。" Exit Sub End If ' C3、D3、E3、F3セルの内容をフォーマット formattedCombinedContent = c3Content & "-" & d3Content & "-" & e3Content & "-" & formattedF3Content ' カスタムファイル名を作成 customName = dateStr & "(" & formattedCombinedContent & ")他" & lastRow & "件" ' ファイルの保存先パスを作成 fileName = folderPath & "\" & customName ' ファイルを保存 With Application.fileDialog(msoFileDialogSaveAs) .Title = "保存先フォルダを選択してください" .InitialFileName = fileName & ".xlsm" .AllowMultiSelect = False If .Show <> -1 Then MsgBox "保存先フォルダが選択されませんでした。", vbExclamation Exit Sub End If .Execute MsgBox "ファイルが保存されました。", vbInformation End With End Sub
質問日時: 2024/05/23 01:13 質問者: Wrangleruk
ベストアンサー
1
0
-
VBA 複数のエクセルから一つのエクセルに貼り付ける
画面に開いている複数のエクセルをコピーして、別のエクセルに一つのデータにしたい場合、どのような式を書けばいいですか?
質問日時: 2024/05/21 19:09 質問者: stop-stop
回答受付中
1
0
-
【ExcelVBA】値を変更しながら連続でPDFを作成し,それらを結合した状態で出力するコード
office365を使用しています。 1行に1件ずつデータが入っているExcelファイルで,I2セルからI3セルで指定した範囲の行のデータを「様式」シートに順番に反映させながら,連続してPDFを作成するコードを以下のように作成しております。 以下のコードだと,PDFファイルが1件(1行)につき,一つずつ作成されますが,1つのファイルとして結合した状態で出力させるにはどのようなコードにしたら良いか,ご教示いただけないでしょうか。 おそらく,クリップボードのようなところで,1件(1行)のデータを様式シートに反映させたらそれを保存し,順次,次の行のデータを反映させてクリップボード上のデータに追加していくという動きのコードになると思うのではないかと思うのですが,調べてもわかりませんでした。 Sub 連続PDF作成() Dim i As Long Dim j, k As Long Dim l As String Dim myfolder As String Application.ScreenUpdating = False myfolder = ThisWorkbook.Path + "\" j = Worksheets("回答").Range("I2").Value k = Worksheets("回答").Range("I3").Value For i = j To k Worksheets("回答").Range("A5").Value = Worksheets("回答").Cells(i + 9, 1).Value l = Sheets("回答").Range("N6").Value & "・" & Sheets("回答").Range("G6").Value & "・" & Sheets("回答").Range("D6").Value Worksheets("様式").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfolder & "回答\" & l & ".pdf", OpenAfterPublish:=False, IgnorePrintAreas:=False Next i Application.Goto Sheets("回答").Range("A5") Application.ScreenUpdating = True End Sub
質問日時: 2024/05/20 10:43 質問者: qazxcvfr4
回答受付中
3
0
-
【マクロ】1つのマクロの中に、ブック指定とシート指定が混在しても良いのですか?
【質問したい事】 下記の【2つめのマクロ】について 同じブック内で動かすコードです 3行あり、1行目はブック指定。2・3行目はシート指定です。 全て同じブック内です。 このような書き方は適切でしょうか? ※次のコードの事です Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate なお、当該マクロの前に別ブックにて別マクロが動いた後に 当該マクロのブックに移動をして、実行する為、シートとのみ書いていると 動きませんでした。よって、1行目だけブック・シートに変更したところ動きました 質問は同じマクロ内で、ブックとシートが混在してよいですか?です 宜しくお願いします なお、下記のマクロは全て動きます Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate 【下記の2つのマクロを呼出。実行】 Sub call() Call 別ブックへ転記ファイル名変更 Call 列クリア End Sub 【1つめのマクロ】 Sub 別ブックへ転記ファイル名変更() Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow2 As Long Dim row2 As Long Set ws1 = Worksheets("転記元") Set wb2 = Workbooks.Open(ws1.Range("A3").Value) 'ブックパス Set ws2 = wb2.Worksheets(ws1.Range("A5").Value) '上記のシート名 maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row row2 = maxrow2 + 1 ws2.Cells(row2, 1).Resize(1, 3).Value = ws1.Cells(1, 1).Resize(1, 3).Value End Sub 【2つめのマクロ】⇒質問したいコード Sub 列クリア() Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate Worksheets("画面貼付").Columns("d").Clear Worksheets("転記元").Activate End Sub
質問日時: 2024/05/16 07:13 質問者: aoyama-reiko
ベストアンサー
2
0
-
VBA ユーザーフォーム ボタンクリック後にセルにフォーカス
VBAのユーザーフォームについて質問です。 ユーザーフォーム上のコマンドボタンをクリックすると、セルに値が入力されるようにしました。このとき、コマンドボタンをクリックすると、フォーカスがユーザーフォームに残っています。これを、コマンドボタンをクリックした後、自動で対象のセルにフォーカスすることはできるでしょうか?何かよい方法はあるでしょうか? イメージは、 1 コマンドボタンクリック 2セルに値がセットされる 3 マウスを手放す 4 キーボードからセルの操作ができる状態(キーボードの矢印キーでセル移動ができる状態など) のような状態にしたいです。
質問日時: 2024/05/16 02:17 質問者: tsukita
ベストアンサー
3
0
-
エクセルについて
添付画像のsheet3のA.B.C.D.列の赤枠部とsheet1のA.G.H.I列の赤枠部が一致したらsheet3のG列の単価をsheet1のE列に転記することは可能でしょうか? マクロor関数どちらでもよいですが、希望は関数です。 よろしくお願いいたします。
質問日時: 2024/05/14 23:26 質問者: Wrangleruk
ベストアンサー
2
0
-
ExcelのVBAコードについて教えてください。
シート名「昇降機【青紙】(裏面)」に 下記のコードを設定しております。 このコードは 各セル("A6, A12, A13")のごれか一つに「■」と表示された場合 他の2つのセルには何も表示されません。 各セル("A6, A12, A13")をプルダウンで選択し「■」を表示されると このコードは上手く行くのですが、 例えば セルA6に「=昇降機【青紙】チェックリスト!I27」の式で「■」を表示 同じく セルA12に「=昇降機【青紙】チェックリスト!S27」の式で「■」を表示 セルA13に「=昇降機【青紙】チェックリスト!O27」の式で「■」を表示 されるように設定すると コードが上手く行かず、 「=昇降機【青紙】チェックリスト!I27」 「=昇降機【青紙】チェックリスト!S27」 「=昇降機【青紙】チェックリスト!O27」 の「■」が全てのセルに表示されてしまします。 解決方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Range("A6, A12, A13") If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then If Target.Value = "■" Then Select Case Target.Address Case "$A$6" Range("A8").ClearContents Range("A12").ClearContents Range("A13").ClearContents Range("A16").ClearContents Range("A17").ClearContents Case "$A$12" Range("A6").ClearContents Range("A8").ClearContents Range("A13").ClearContents Range("A16").ClearContents Range("A17").ClearContents Case "$A$13" Range("A6").ClearContents Range("A8").ClearContents Range("A12").ClearContents Range("A16").ClearContents Range("A17").ClearContents End Select End If End If End Sub 以上です。 宜しくお願い致します。
質問日時: 2024/05/14 14:38 質問者: エクセル小僧
ベストアンサー
1
0
-
VBAで大量のファイルをシート名ごとに転記やらいろいろしたい!
はじめまして、お世話になります。 当方VBA初心者です。 業務でCSVファイルを読み込み→別ブックへ貼り付け→基準値未満・以上のものを色付け(未満・以上になった回数を増やす)→・・・という作業を毎日手作業で行っております。 CSVファイルで出力されるのは、最大1536個です。 数が多いのでVBAにて処理を行いたいと思い、ネットで探して組んだりしているのですがうまく動きません。 どうかお知恵を貸していただけないでしょうか? やりたいこととしまして ①マクロ入りエクセルが入っているフォルダに保存されたCSVファイルをすべて読み込み ②右側、左側で転記するシートを変更したい (シート名がFPGA1○○日付時間、FPGA2○○日付時間で出力されます) ③1-1-001~6-2-128が入っていない場所は空白で転記されるようにしたい(出力された際に、1-1-001ではなく2-1-001から始まることもあり、挿入→下方向にシフトを行っております) ④転記する際に、各データの上にシート名にある日付時間を挿入したい ⑤転記されたデータから、基準値未満・以上のものをピックアップし、別シートへ転記(転記先の画像を添付いたします) ※棚は6までございます。 ⑥別シートの色付けと乗算 ・色付けは不良回数が3~5回はオレンジ、6回以上で赤になるようにしたいです 以上を組み込んでいただけると幸いでございます。 説明がわかりにくいかもしれませんが、よろしくお願いいたします。
質問日時: 2024/05/13 12:28 質問者: maaaaatam
解決済
3
0
-
Vba 実数および実数タイプの変数について教えてください
いつもお世話になります すみません、昔のプログラムの改良を頼まれたのですが 実数表記と変数表記について、確認の為に教えてください まずは実数表記ですが 通常、プログラムステートメントで A=1.0 とすると A=1# になると思いますが、A=1! と 表記されていますが “!” はSingleタイプを表し、"#" はDoubleタイプを表すと考えて良いですか? 次に実数タイプの変数についてですが dim S1# as double の時 変数S1#と、"#"をつかない変数 S1 は同じ値を持つみたいですが、同じ変数になるのですか? これって昔のBasicの名残ですか? すみません、基本的なことですがよろしくお願いいたします
質問日時: 2024/05/10 11:07 質問者: 公共ごま
ベストアンサー
3
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると、メッセージが表示され、ダイアログが開き、不要ファイルをマウスで選択して、「OK」をクリックすると不要ファイルが削除されますが、 マクロを実行すると画像のエラーメッセージが表示され、 コードの「 Sh As SHFILEOPSTRUCT」部分の色が変色し、上手くマクロを実行できません。 解決方法を教えてください。 宜しくお願い致します。 現行のマクロ ub 不要ファイル選択削除() Dim InitialPath As String InitialPath = ThisWorkbook.Path Dim rs As Integer rs = MsgBox("ファイルを削除します。", vbCritical + vbOKCancel, "削除の確認") If rs = vbOK Then Dim sPath As Variant With Application.FileDialog(msoFileDialogFilePicker) .Title = "削除するファイルを選択してください" .InitialFileName = InitialPath .AllowMultiSelect = True If .Show = True Then ReDim filePath(0) For Each sPath In .SelectedItems If filePath(0) <> "" Then ReDim Preserve filePath(UBound(filePath) + 1) End If filePath(UBound(filePath)) = sPath Next Call MoveDustbox(filePath) Else MsgBox "削除をキャンセルしました。", vbInformation .Execute End If End With End If End Sub Sub MoveDustbox(vPath As Variant) Dim sPath As Variant Dim Sh As SHFILEOPSTRUCT Dim ret As Long Sh.hwnd = Application.hwnd Sh.wFunc = &H3 Sh.fFlags = &H40 + &H10 If Not IsArray(vPath) Then Sh.pFrom = vPath ret = SHFileOperation(Sh) Else For Each sPath In vPath Sh.pFrom = sPath ret = SHFileOperation(Sh) Next End If End Sub 以上となります。宜しくお願い致します。
質問日時: 2024/05/09 09:12 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルVBAについて
tatsumaru77様 以前投稿した内容で転記の追加をしたいのですが、内容は添付画像のようにA列に〇がある場合にW列の品名を別ファイルのC列に追加、AS列の個数をD列に追加です。 追加していく条件は変更はありません。 現在使用しているコードも記載しておきます。 申し訳ありませんが、よろしくお願いいたします。 Private Sub case8() Dim fpath As String Dim wb As Workbook Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow1 As Long Dim row1 As Long Dim row2 As Long Set ws1 = ActiveSheet fpath = "N:\01生産管理課\01 個人ファイル\5000田中\図番転記.xlsm" Set wb2 = Nothing For Each wb In Workbooks If wb.Name = "図番転記.xlsm" Then Set wb2 = wb Exit For End If Next If wb2 Is Nothing Then Set wb2 = Workbooks.Open(fpath) End If Set ws2 = wb2.Worksheets(1) row2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row If ws2.Cells(row2, "A").Value <> "" Then row2 = row2 + 1 End If maxrow1 = 500 For row1 = 10 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & "10_00*" row2 = row2 + 1 End If Next End Sub
質問日時: 2024/05/06 12:26 質問者: Wrangleruk
ベストアンサー
1
0
-
VBA レジストリの値の読み方について教えてください
いつもお世話になります 今、VBAを使ってExcelからDocuworksへの出力プログラムを作成しています 今まではDocuWorksのフォルダーを指定して出力していましたが Versioniより場所が変わることがあり、フォルダを特定するために レジストリを探していました (ほかに特定する場所があればよいのですが) そこで見つけたのが添付ファイルの場所でしたが 上手く読めませんでした 今まではVbaの「VB and VBA Program Settings」という場所の レジストリを使っていたので sValue = GetSetting("MyChkBox301", "Main", "IsCheckBox315", "False") のように使っていたのですが 今度はよそのSofyWareのレジストリを使うので下記のようにしてみましたが 見つからないみたいで、Svalue=False になってしまいます sValue = GetSetting("HKEY_CURRENT_USER\Software\FUJIFILM\MPM3", "MPWS", "UserFolder", "False") 添付ファイルのUsefolderの値を読み込みたいのですが 読み取り方が分かりましたら教えてください 以上、宜しくお願い致します
質問日時: 2024/05/03 19:08 質問者: 公共ごま
ベストアンサー
1
0
-
VBAの計算で@が出てしまう件
書式設定で文字列に設定してあるセルがあります。 C列やD列に"123456"や"56987"の値が入っています。 こちらをVBAでSUMやVALUEを使って計算しているのですが、なぜか実行後セル内にSUM(VALUE(@C1:C2))と@が入ってしまいます。原因、対処法を教えてください。 以下がそのコードです。(VALUEを使用すると@が入ってくる) SetSumRanges ws, emptyRow, lastRow, baseColumn, sumRange1, sumRange2, sumRange3, sumRange4, sumRangeFlg, "C", "D" Set sumRange1 = ws.Range(sumRange1Column & emptyRow + 1 & ":" & sumRange1Column & lastRow) ws.Range("A1").Formula = "=SUM(VALUE(" & sumRange1.Address & "))"
質問日時: 2024/05/02 17:21 質問者: aaaakkk
ベストアンサー
2
0
-
2つのマクロでチェックボックスが連動しません
詳しい方、ご教授ください。 大量にチェックボックスを作成する必要がある為、一つ一つセルを連動せずに、ネットを参考にして以下のマクロで作成しました。① Sub チェックボックス作成() With ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, 10) .Value = Not .Value End With その後特定の列ごとに一括でチェックボックスのオンオフができるように以下のマクロを作成しました。② Sub 稼働3() Dim chk For Each chk In ActiveSheet.CheckBoxes If chk.TopLeftCell.Column = 3 Then chk.Value = False End If Next End Sub そうすると②のマクロを実行した結果が①の値を返すセルに反映しません。 解決方法がわからずどなたかお知恵を貸してください。 宜しくお願いします。
質問日時: 2024/04/27 14:44 質問者: mikiduckduck
ベストアンサー
2
1
-
WORD VBA プログラム修正をお願いします。
以下のWORD VBAは選択したテーブル内のデータをワイルドカード検索し、抽出されたデータを重複非表示、降順ソートでMSGBOXに表示するものです。 問題が出ております。それが、WORDファイルに4つのテーブルがあるとして、最初のテーブルを選択して検索すると、2番目から4番目のテーブルにあるデータも一緒に検索されてしまいます。2番目のテーブルで検索すると、3から4番目のデータが、3番目のテーブルで検索すると、4番目のデータが一緒に表示されてしまいます。4番目のテーブルを選択した時のみ、4番目のデータが表示されます。 下のVBAは選択したテーブル内で検索していると思うのですが、どこに問題があるかわかりません。どなたか教えていただけないでしょうか、よろしくお願い致します。 Sub SearchUniqueAndDisplaySelectedTable() Dim tbl As Table Dim rng As Range Dim result As String Dim foundItems As New Collection Dim item As Variant Dim i As Integer ' 選択されたテーブルを取得します Set tbl = Selection.Tables(1) ' 結果を格納する変数を初期化します result = "" ' テーブル内のすべてのテキストを検索します For Each rng In tbl.Range.Cells ' セル内のテキストを検索します With rng With .Find .Text = "XYZ Reg. on 20[0-9]{1,2}/[0-9]{1,2}/[0-9]{1,2}" .Forward = True .Wrap = wdFindStop .MatchWildcards = True ' ワイルドカード検索を実行します If .Execute Then ' 重複したデータをチェックして追加します If Not foundItemsExists(.Text, foundItems) Then foundItems.Add .Text, .Text End If End If End With End With Next rng ' 検索結果を配列に変換します Dim resultsArray() As Variant ReDim resultsArray(foundItems.Count - 1) For i = 1 To foundItems.Count resultsArray(i - 1) = foundItems(i) Next i ' 配列を降順にソートします Call SortArray(resultsArray) ' 結果を文字列に変換します For i = LBound(resultsArray) To UBound(resultsArray) result = result & resultsArray(i) & vbCrLf Next i ' 結果を表示します If result <> "" Then MsgBox "検索結果:" & vbCrLf & result, vbInformation, "検索結果" Else MsgBox "指定された文字列が見つかりませんでした。", vbExclamation, "検索結果" End If End Sub ------------------------------------------------------------------------------------------- Function foundItemsExists(item As Variant, collection As Collection) As Boolean On Error Resume Next foundItemsExists = Not IsEmpty(collection(item)) On Error GoTo 0 End Function ----------------------------------------------------------------------------------------- Sub SortArray(ByRef arr As Variant) Dim i As Long, j As Long Dim temp As Variant For i = LBound(arr) To UBound(arr) - 1 For j = i + 1 To UBound(arr) If arr(i) < arr(j) Then temp = arr(i) arr(i) = arr(j) arr(j) = temp End If Next j Next i End Sub
質問日時: 2024/04/25 23:43 質問者: oldhidesan
ベストアンサー
2
0
-
Vba SelStart、SelLen教えてください教えてください
いつもお世話になります 今、TextBoxを並べて入力しようとしていますが EnterKey入力では文字を全部、青く選択するのですが ↑Keyではカーソルが文字の後ろに ↓Keyではカーソルが文字の前に来るだけで青く選択してくれません これってダメなんですかね、教えてください 一応、質問用にプログラムを用意しました Sub test() UserForm1.Show End Sub Option Explicit Dim isw Private Sub UserForm_Activate() TextBox1.Value = 10 TextBox2.Value = 20 TextBox1.SetFocu End Sub Private Sub TextBox1_Enter() 'テキストボックスに入ったら色変える isw = 1 With TextBox1 .BackColor = RGB(&H0, &HFF, &HFF) .SelStart = 0 .SelLength = Len(TextBox1) End With End Sub Private Sub TextBox2_Enter() 'テキストボックスに入ったら色変える isw = 2 With TextBox2 .BackColor = RGB(&H0, &HFF, &HFF) .SelStart = 0 .SelLength = Len(.Text) End With End Sub Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsNumeric(TextBox1.Text) Then TextBox1.BackColor = RGB(&HFF, &HFF, &HFF) ElseIf TextBox1 <> "" Then MsgBox ("数値以外の文字が入力されています") TextBox1 = "" Cancel = True End If End Sub Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsNumeric(TextBox2.Text) Then TextBox2.BackColor = RGB(&HFF, &HFF, &HFF) ElseIf TextBox2 <> "" Then MsgBox ("数値以外の文字が入力されています") TextBox2 = "" Cancel = True End If End Sub Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Call chkFKey(KeyCode) End Sub Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Call chkFKey(KeyCode) End Sub Private Sub chkFKey(ByVal KeyCode As MSForms.ReturnInteger) If KeyCode = vbKeyReturn Then If isw = 2 Then isw = 0 With Me.Controls("TextBox" & isw + 1) .SetFocus .SelStart = 0 .SelLength = Len(.Text) End With ElseIf KeyCode = vbKeyDown Then If isw = 2 Then isw = 0 With Me.Controls("TextBox" & isw + 1) .SetFocus .SelStart = 0 .SelLength = Len(.Text) End With ElseIf KeyCode = vbKeyUp Then If isw = 1 Then isw = 3 With Me.Controls("TextBox" & isw - 1) .SetFocus .SelStart = 0 .SelLength = Len(.Text) End With End If End Sub 長くてすみません 以上、宜しくお願い致します
質問日時: 2024/04/25 17:12 質問者: 公共ごま
ベストアンサー
1
0
-
VBA SaveChanges 上書きされない
Excel 2019 処理内容 ブック内のすべてのグラフのスケール変更 質問内容 wb.Close SaveChanges:=True 上記では上書き保存がされません。 以下の記述では問題なくできます。 wb.Close wb.Save テストで、保存前にwb.Savedの返り値を見てみたのですが、 スケール変更の処理を終えてもTrueでした。 Excelでは、グラフのスケール変更のみは「変更なし」という扱いということでしょうか。
質問日時: 2024/04/22 15:10 質問者: ぶつりがくっておいしいの
解決済
1
0
-
現在のブックを閉じないで、マクロ抜きの(現在のブックの)コピーを作成したい
次のプログラムでコピーできるのですが、コピーされたSample1.xlsxを立ち上げると「ファイル形式と拡張子が一致していません」となってしまいます。 Sub Sample() Application.DisplayAlerts = False ActiveWorkbook.SaveCopyAs "C:\Sample1.xlsx" Application.DisplayAlerts = True End Sub
質問日時: 2024/04/20 07:58 質問者: payphone
ベストアンサー
5
0
-
VBA listBoxから
Private Sub ListBox1_Click() Dim response As VbMsgBoxResult response = MsgBox("編集しますか?記載情報に移動しますか?", vbYesNoCancel + vbQuestion, "選択の確認") If response = vbNo Then ' 編集しない場合 ' 選択された行にカーソルを移動 Sheet1.Cells(ListBox1.ListIndex + 1, 1).Select ElseIf response = vbYes Then ' UserForm1 に検索した情報を表示 UserForm1.ComboBox1.Value = ComboBox1.Value UserForm1.TextBox3.Value = ComboBox5.Value ' 同様に他のコントロールにデータをセットする ' UserForm1 を表示 UserForm1.Show End If Unload UserForm2 End Sub 現状このようなコードでリストボックスに表示した行をクリックして編集するならUserForm展開するのと記載情報に移動しますか?の時sheet1の該当する行にカーソル移動させたいのですがうまくいきません AIに相談してもなかなかはかどりません(´;ω;`) listBoxに表示している情報で検索対象となる列は表示の一番右でListIndex, 0だと思うのですが それでもうまくいきませんでした sheet1のA列に該当する値が(連番)あるのですがカーソルはlistBoxに表示した行をsheet1でカーソルを移動させる感じになっている気がします どうか修正できる方おりましたらよろしくお願いしますm(__)m
質問日時: 2024/04/18 09:16 質問者: kacky76
解決済
4
0
-
VBAで各列の"+"と"o"の合計数を数え3行目と4行目に入力したい
VBA初心者です。 1行目は22時を始めとし23時、0時、1時、~~と21時まで続く時間を 2行目は各時間の0分台、 10分台、 20分台、30分台、40分台、50分台を表しています。 5行名以降に記されている"+"と"o"の合計数を数え、それぞれ"+"の合計数を3行目に、”o"の合計数を4行目に記すVBAを作成したいです。 VBAを学習したばかりの自分にはハードルが高く、こちらで質問させていただきます。 よろしくお願いいたします。
質問日時: 2024/04/17 14:20 質問者: yuni8787
ベストアンサー
7
0
-
VBA初心者 Ctrl+での操作、ボタンに登録での操作
マクロを記録し、Ctrl+aなどで操作をする場合、特定のセルにカーソルを合わせていないといけませんが、ボタンにマクロを記録した場合は固定セルにカーソルを合わせていなくても大丈夫ですか? また、上記の2つのマクロ起動に違いはありますか?
質問日時: 2024/04/16 14:41 質問者: stop-stop
解決済
2
0
-
VBA 複数条件の分岐処理の上手な方法
VBAで次のような条件を満たすように処理を行いたいと思いますが 上手い方法が分からずにいます。下の★マークのところで、 条件を複数選択できるようにしたいのですが、 スマートな方法はあるでしょうか。 なお、使用するのは自分自身だけです。 ・選択した範囲のセルを走査して、セルの値の一部に特定の文字(ここでは HIT とします)が 含まれた場合に、そのセルに色をつける。 ・その際、次のように対象セルの周りのセルを同時に色付けするようにしたい。 プロージャを実行する際に、オプションとして同時に任意に複数選択できるようにしたい。★ 1 対象セルに色付けする 2 対象セルの上のセルに色付けする 4 対象セルの下のセルに色付けする 8 対象セルの右のセルに色付けする 16 対象セルの左のセルに色付けする 上記の 0,1,2,4,8 はこのQAの説明のために付けた番号なので、 プログラミングでは別の番号や文字列で処理してよい よろしくお願いします。 以下、自分なりに考えた方法 ① 上で書いた1,2,4,8,16 のうち、実行したいものの番号を足し合わせた数を入力して処理する。 たとえば、対象セルとその上のセルに色付けする場合は 1+2=3 と考え 3 を入力する。 2進法を利用した方法なのですが、入力された数をVBA側で受け取ったあとの 処理を簡単にかけずにいます。 受け取った値 X を2で割って、その余り R1 が0なら~~、その余り R1 が1なら~~ 次に、X-R1 を2で割って、その余り R2 が 0 なら~~ ・・・ ② ユーザーフォームを使って、条件をえらぶチェックボックスなどを配置し、 チェックボックスがチェックされたかどうかを判定して処理する。 全部で最大 5 つの複数選択となるので、5 つのチェックボックスを配置する。 IF~End IF 文を5回使って処理する。 など、考えられますが、ベテランの方はどのようにプログラミングするのでしょう。
質問日時: 2024/04/15 04:05 質問者: tsukita
ベストアンサー
4
1
-
VBAに詳しい方教えてください。
前に少しVBAを使ったことがありましたが、すっかり忘れてしまい急に使用することになりました。 やりたいことは ファイル名をyyyymmdd【▲▲】.xlsxでディスクトップに保存して、閉じる。 出来れば、読み取りパスワード1234も付けたいです。 あまり長くならず、簡潔な記載方法はないでしょうか?
質問日時: 2024/04/11 23:13 質問者: sorairo17go
解決済
2
0
-
VB.net(VB)で、フォームにExcelファイルを埋め込む方法を教えてください
VB初心者です。 VisualStudio2019を使っています。 VBのフォームに、Excelを埋め込むことはできるのでしょうか? いくつかのサイトを見て真似してみたのですが、Excel自体が起動してしまって、フォームには埋め込まれませんでした。 DataGridViewではなく、ExcelをVBの中で使いたいです。
質問日時: 2024/04/11 18:02 質問者: 焼酎ロックで
解決済
2
0
-
エクセルのマクロについて教えてください。
下記のマクロは以前、教えて頂いたマクロで、マクロを実行すると チェックボックスに「✔」が入ります。 そのマクロはアクティブシートのチェックボックスに「✔」が付きますが、 アクティブシートでは無く、シートを指定できる方法を教えてください。 指定シート名「建築物(完了検査)(第4号様式)」です。 宜しくお願い致します。 現状のマクロ Sub 特例1号チェック() With ActiveSheet ActiveSheet.CheckBoxes("Check Box 51").Value = xlOn ActiveSheet.CheckBoxes("Check Box 60").Value = xlOn End With End Sub 以上になります。 宜しくお願い致します。
質問日時: 2024/04/10 17:35 質問者: エクセル小僧
ベストアンサー
3
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると,同じ作業フォルダ内の指定ファイル名に 作業ブックから、指定セル値をコピー出来きます。 コードの「"\【新行政報告】行政報告チェックリスト_Copy.xlsm")」をコピー先のファイルとして指定しております。 【新行政報告】行政報告チェックリスト_Copy.xlsmのgファイル名が物件によって 例えば 「【新行政報告】北海 太郎邸.xlsmとファイル名が変更になります、 先頭の「【新行政報告】」はどのファイルでも変更がありませんので この部分をワイルドカードを使用して 「【新行政報告】*.xlsm」 と変更出来る方法を教えてください。 よろしくお願いいたします。 現状のマクロです。 Sub 新行政報告に項目コピー() Dim wsfrom As Worksheet, wsto As Worksheet Set wsfrom = ThisWorkbook.Sheets("1") With Workbooks.Open(ThisWorkbook.Path & "\【新行政報告】行政報告チェックリスト_Copy.xlsm") Set wsto = .Sheets("建築物(確認申請)(第1号様式)") wsto.Range("C1") = wsfrom.Range("F10").Value wsto.Range("C2") = wsfrom.Range("F13").Value wsto.Range("V2") = wsfrom.Range("D39").Value wsto.Range("B180") = wsfrom.Range("O24").Value .Save .Close End With End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/04/08 16:48 質問者: エクセル小僧
ベストアンサー
3
0
-
エクセルのマクロについて教えてください。
下記のマクロは以前教えて頂いたマクロを少しアレンジしており、 マクロを実行すると、指定の別ブックのマクロを複数実できますが、 マクロを実行すると 画像のエラーメッセージが表示され コードの「 .Workbooks」が黄色く変色してマクロを実行できません、 解決方法を教えてください。 現状のマクロ Sub 別ブック複数マクロ実行() Const FILE_NAME = "\【連動版】行政報告チェックリスト(戸建て)_Copy.xlsm" Const PROC_NAME = "特例1_3号チェック,都市ガス,都市計画法53条" Set wb = .Workbooks.Open(ThisWorkbook.Path & FILE_NAME) For Each PROC In Split(PROC_NAME, ",") .Run wb.Name & "!" & PROC 'アラートを消す .DisplayAlerts = False Next PROC wb.Save wb.Close End With app.Quit End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/08 10:08 質問者: エクセル小僧
ベストアンサー
4
0
-
Excel VBA 定義されたプロージャ名、関数名の取得
次のようなVBAのコードをご指南ください。 実行すると、アクティブブックのモジュール内で定義されたサブプロージャ名や関数名を、種類とそれが定義されたモジュール名を併記する形で、メッセージボックスで一覧表示するマクロ。 実行結果のイメージ Sheet1 (****) プロージャー procA() Sheet1 (****) プロージャー procB() ThisWorkbook イベントプロージャー workbook_open() 標準モジュール プロージャー test() 標準モジュール 関数 func(hikisuA As Long, hikusuB As String) 他者がつくったマクロファイルが複雑で、モジュールがたくさんあります。どのモジュールにマクロが定義されているか、VBEを開いて1つ1つモジュールをダブルクリックして調べるのが面倒です。情報を得るのが目的なので、実行結果のイメージに深いこだわりはありません。詳しい方、よろしくお願いします。
質問日時: 2024/04/07 00:29 質問者: tsukita
ベストアンサー
1
1
-
エクセルのマクロについて教えてください。
下記のマクロは先日教えていただいたマクロで 作業ブックの指定セル値を別ブックの指定セルにコピー出来るマクロですが コピー元のセル値を複数指定し、コピー先のセル値も同じく複数指定したいのですが、 コードを下記のように設定しても上手く行きませんでした。 Book1の値をコピー ThisWorkbook.Sheets("1").Range("F10,F12").Copy 'Book2に値貼り付け Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Sheets("建築物(確認申請)(第1号様式)").Range("C1,E4") = ThisWorkbook.Sheets("1").Range("F10,F12").Value 解決方法を教えてください。 現行のマクロ Sub 新行政報告にコピー() 'コピー先のファイルを開く Workbooks.Open ThisWorkbook.Path & "\【連動版】行政報告チェックリスト(戸建て).xlsm" 'Book1の値をコピー ThisWorkbook.Sheets("1").Range("F10").Copy 'Book2に値貼り付け Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Sheets("建築物(確認申請)(第1号様式)").Range("C1") = ThisWorkbook.Sheets("1").Range("F10").Value Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Save Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Close End Sub
質問日時: 2024/04/06 10:16 質問者: エクセル小僧
ベストアンサー
4
0
-
Excelのマクロについて教えてください。 下記のマクロを実行すると 別ブックに指定セル値をコピーで
Excelのマクロについて教えてください。 下記のマクロを実行すると 別ブックに指定セル値をコピーできます このマクロだとコピー先のフォルダを指定してます Workbooks.Open "C:\Users\160931\Desktop\テスト\ が この部分を マクロを設定しているブックと同じフォルダ内 ThisWorkbook.Path にあるファイルを指定出来る 方法を教えてください。 よろしくお願い致します 現状のマクロ Sub 新行政報告にコピー() 'コピー先のファイルを開く Workbooks.Open "C:\Users\160931\Desktop\テスト\【連動版】行政報告チェックリスト(戸建て).xlsm" 'Book1の値をコピー ThisWorkbook.Sheets("1").Range("F10").Copy 'Book2に値貼り付け Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Sheets("建築物(確認申請)(第1号様式)").Range("C1").PasteSpecial Paste:=xlPasteValues Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Save Workbooks("【連動版】行政報告チェックリスト(戸建て).xlsm").Close End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/05 21:25 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると指定フォルダ内 「C:\Users\160931\Desktop\テスト\」 の指定ファイル 「テストチェックリスト.xlsm」 の別ブックの マクロ 「チェック」 を実行できますが、 実行マクロを複数設定出来る方法を教えてください。 例えば 「チェック」「チェック2」「チェック3」 現状のマクロ Sub 別ブックマクロ実行() Const FILE_NAME = "C:\Users\160931\Desktop\テスト\テストチェックリスト.xlsm" Const PROC_NAME = "チェック" Dim app Set app = CreateObject("Excel.Application") With app 'Excel非表示 .Visible = False Dim wb Set wb = .Workbooks.Open(FILE_NAME) .Run wb.Name & "!" & PROC_NAME 'アラートを消す .DisplayAlerts = False wb.Save wb.Close End With app.Quit End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/05 09:58 質問者: エクセル小僧
ベストアンサー
3
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行するとチェックボックスに「✔」が入るように設定しましたが、 エラーは出ませんが、 「✔」が表示されません。 なお、チェックボックス名は「CheckBox51」と表示されております。 又、その他のチェックボックスを指定すると 例えば「.CheckBoxes(313)を設定すると エラー「1004」が表示されます。 私の希望はマクロを実行して指定のチェックボックスに「✔」を表示させたいのですが、 解決方法を教えてください。 現状のマクロ Sub Macro1() With ActiveSheet .CheckBoxes(51).Value = True End With End Sub 宜しくお願い致します。
質問日時: 2024/04/03 17:56 質問者: エクセル小僧
ベストアンサー
2
0
-
Excel-VBAのmsgBox()の不思議
Excel-VBA初心者です。初歩的なことをお聞きします。以下のプログラムで、2)の場合がエラーにならないのは何故でしょうか。引数は文字列データである必要があると思うのですが、数字でもエラーが出ません。本来は型変換をする3)が正しいと思うのですが...。お詳しい方、解説お願いいたします。 ------------ Sub test() Dim str As String Dim num As Long str = "あいうえお" num = 100 '1) MsgBox "str:" & str '2) MsgBox "num:" & num '3) MsgBox "CStr(num):" & CStr(num) End Sub
質問日時: 2024/04/03 17:06 質問者: hgama1024
解決済
5
0
-
エクセルのマクロについて教えてください。
下記のマクロは先日より教えて頂いたマクロです。 作業シート名「建築物(確認申請)(第1号様式)」の セル値「AB1」の数字をワイルドカードで検索し 該当するファイルの指定シートを作業ブックのシートにコピーできますが、 作業シート名「建築物(確認申請)(第1号様式)」の セル値「AB1」の数字が表示されていなくても マクロを実行すると 指定フォルダ先のファイルを呼び込み、作業ブックにシートがコピーされてしまします。 マクロを実行し 作業シート名「建築物(確認申請)(第1号様式)」の セル値「AB1」の数字が表示され、該当ファイルがある場合のみ コピー元のシートを作業ブックにコピー出来る方法を教えてください。 宜しくお願い致します。 現状のマクロ Application.DisplayAlerts = False Dim srcFolderPath As String Dim srcFileName As String Dim srcSheetName As String Dim destWorkbook As Workbook Dim destSheet As Worksheet Dim srcWorkbook As Workbook Dim srcSheet As Worksheet ' コピー元のフォルダパスとファイル名を指定 srcFolderPath = "\\nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件(完了検査対象)\2024年 【担当】確認番号 建物名称\03月\" srcFileName = "*" & ThisWorkbook.Worksheets("建築物(確認申請)(第1号様式)").Range("AB1").Value & "*.xlsm" ' コピー先の作業ブックとシートを指定 Set destWorkbook = ThisWorkbook Set destSheet = destWorkbook.Sheets("第4号様式(印刷用)") ' コピー元のファイルを検索 srcFileName = Dir(srcFolderPath & srcFileName) ' コピー元のブックを開く Set srcWorkbook = Workbooks.Open(srcFolderPath & srcFileName) 'シート名の値を設定 arr = Array("受付", "青紙表", "1", "1号確認", "4号完了") 'シート名でループ For Each sname In arr ' コピー元のシートを取得 Set srcSheet = srcWorkbook.Sheets(sname) ' コピー元のシート名を取得 srcSheetName = srcSheet.Name ' コピー元のシートをコピー先にコピー srcSheet.Copy After:=destSheet Next ' コピー元のブックを閉じる srcWorkbook.Close SaveChanges:=False Application.DisplayAlerts = True End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/02 16:12 質問者: エクセル小僧
ベストアンサー
2
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると 左からのシート「11」番目の保護シートを解除できますが、 このコードを 指定シート名に変更出来る方法を教えてください。 現状のマクロ Sub シートの保護解除() ThisWorkbook.Worksheets(11).Unprotect Password:="abc" End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/02 14:29 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると、コピー元の指定フォルダ内にあるワイルドカードで指定したファイルの指定シートを作業ブックにコピー出来ますが、このマクロではコピー元の指定シートが 「' コピー元のシートを取得(左から4番麺目のシート) Set srcSheet = srcWorkbook.Sheets(4)」となっており、 この部分を複数の直接名のシートに変更出来る方法を教えてください。 コピー元のシート名「受付」「青紙表」「1号様式」「2号式」 以上です。 現状のマクロです。 Dim srcFolderPath As String Dim srcFileName As String Dim srcSheetName As String Dim destWorkbook As Workbook Dim destSheet As Worksheet Dim srcWorkbook As Workbook Dim srcSheet As Worksheet ' コピー元のフォルダパスとファイル名を指定 srcFolderPath = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件(完了検査対象)\2024年 【担当】確認番号 建物名称\01月\" srcFileName = "*23045888*.xlsm" ' コピー先の作業ブックとシートを指定 Set destWorkbook = ThisWorkbook Set destSheet = destWorkbook.Sheets("第4号様式(印刷用)") ' コピー元のファイルを検索 srcFileName = Dir(srcFolderPath & srcFileName) ' コピー元のブックを開く Set srcWorkbook = Workbooks.Open(srcFolderPath & srcFileName) ' コピー元のシートを取得(左から4番麺目のシート) Set srcSheet = srcWorkbook.Sheets(4) ' コピー元のシート名を取得 srcSheetName = srcSheet.Name ' コピー元のシートをコピー先にコピー srcSheet.Copy After:=destSheet ' コピー元のブックを閉じる srcWorkbook.Close SaveChanges:=False End Sub 以上となります。 宜しくお願い致します
質問日時: 2024/04/02 06:34 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると指定フォルダ先のワイルドカードで指定したファイルの指定シートを 作業ブックの指定した場所にコピーが出来ます。 srcFileName = "*12345678*.xlsm"の 「23045888」この数字の部分を 作業ブックの指定シート名「建築物(確認申請)(第1号様式)」の 指定セル値「AB1」に出来る方法を教えてください。 現状のマクロ Dim srcFolderPath As String Dim srcFileName As String Dim srcSheetName As String Dim destWorkbook As Workbook Dim destSheet As Worksheet Dim srcWorkbook As Workbook Dim srcSheet As Worksheet ' コピー元のフォルダパスとファイル名を指定 srcFolderPath = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件(完了検査対象)\2024年 【担当】確認番号 建物名称\01月\" srcFileName = "*23045888*.xlsm" ' コピー先の作業ブックとシートを指定 Set destWorkbook = ThisWorkbook Set destSheet = destWorkbook.Sheets("第4号様式(印刷用)") ' コピー元のファイルを検索 srcFileName = Dir(srcFolderPath & srcFileName) ' コピー元のブックを開く Set srcWorkbook = Workbooks.Open(srcFolderPath & srcFileName) ' コピー元のシートを取得(左から4番麺目のシート) Set srcSheet = srcWorkbook.Sheets(4) ' コピー元のシート名を取得 srcSheetName = srcSheet.Name ' コピー元のシートをコピー先にコピー srcSheet.Copy After:=destSheet ' コピー元のブックを閉じる srcWorkbook.Close SaveChanges:=False End Sub 以上となります。 宜しくお願い致します
質問日時: 2024/04/01 17:53 質問者: エクセル小僧
ベストアンサー
2
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると、作業シートの指定セル部分に文字があれば、自動で行調整が出来ます。 このマクロを指定シートの指定セル値に変更出来る方法を教えてください。 指定シート名「質疑」指定セル値同じく「Range("C26:C60")」です。 現状のマクロ Sub 行調整() Dim r As Range Dim tmp, n As Integer, i As Integer For Each r In Range("C26:C60") If WorksheetFunction.CountIf(r.Resize(, 4), "<>") > 0 Then r.Rows.AutoFit '折り返し設定とフォントサイズ For i = 0 To 3 If InStr(r.Offset(, i), vbLf) > 0 Then If n < UBound(Split(r.Offset(, i), vbLf)) Then n = UBound(Split(r.Offset(, i), vbLf)) + 1 End If End If Next If n > 0 Then tmp = r.RowHeight r.RowHeight = tmp * n '改行コード Alt+Enter n = 0 End If Else r.RowHeight = 27 End If Next End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/04/01 14:54 質問者: エクセル小僧
ベストアンサー
3
0
-
ExcelのVBAコードについて教えてください。
下記のコードを一つにまとめる方法を教えてください。 下記のコードはセル値「F3」に「札幌市」と表示されると マクロ Call 注意2表示 Call 札幌道路図形表示 Call 札幌開発資料図形表示 Call 札幌資料図形表示 が実行されます。 このコードを一つにまとめる方法を教えてください。 現状のコード If Range("F3").Value = "札幌市" Then Call 注意2表示 End If If Range("F3").Value = "札幌市" Then Call 札幌道路図形表示 End If If Range("F3").Value = "札幌市" Then Call 札幌開発資料図形表示 End If If Range("F3").Value = "札幌市" Then Call 札幌資料図形表示 End If 以上となります。 よろしくお願いいたします。
質問日時: 2024/03/28 13:38 質問者: エクセル小僧
ベストアンサー
1
0
-
Word VBA MSGBOX 内で降順表示
下記のVBAはWORDファイル内の青文字で書かれた登録日を検索し、MSGBOXに表示するもので、正常に使えています。 しかし、MSGBOX内の表示がファイル内での順番になっています。昇順または降順表示にしたいのですが、 ネット検索してトライしましたが結果が得られていません。ご指導いただければ大変たすかります。よろしくお願いします。 Sub TEST() '検索 青文字「ABC」+ 日付 Dim vv As Variant Dim i As Integer i = 0 ReDim vv(i) ActiveDocument.Range(0, 0).Select With Selection.Find .Font.Color = wdColorBlue .Text = "登録日 202[0-9]/[0-9]{1,2}/[0-9]{1,2}" .MatchFuzzy = False .MatchWildcards = True Do While Selection.Find.Execute vv(i) = Selection i = i + 1: ReDim Preserve vv(i) Loop End With MsgBox "登録日" + vbCrLf + vbCrLf + Join(vv, vbCrLf) End Sub
質問日時: 2024/03/28 13:12 質問者: oldhidesan
ベストアンサー
3
0
-
エクセルのマクロについて教えてください。
下記のマクロを実行すると 指定フォルダ内の指定ファイルを開く事が出来ますが、 マクロを実行すると、PDFファイルが、Excelシートの呼び込みされてしまします。 マクロを実行した時に、PDFそのままの状態で開く事が出来る方法を教えてください。 現状のマクロ Sub 道路資料を開く() Dim alert As VbMsgBoxResult alert = MsgBox("道路確認照会確認をしますか?", vbYesNo + vbQuestion, "道路確認") If alert <> vbYes Then Exit Sub End If On Error Resume Next Workbooks.Open Filename:=" \\nas-sp01\share\確認部\■意匠\戸建\戸建て電子申請関連\ひな形\資料\道路開発照会資料\道路照会の要否.pdf" End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/03/28 12:00 質問者: エクセル小僧
ベストアンサー
1
0
-
エクセルのマクロについて教えてください。
下記のマクロは以前教えて頂いたマクロで、マクロを実行すると、指定フォルダ内に指定セル値にて 保存されますが、 その時に指定の非表示シート 「List = Array("休日", "受付", "管理表", "300")」 が削除されますが、この部分の非表示シートを全て削除しないように変更出来る方法を教えてください。 現状のマクロ Sub 行政報告標準() Dim alert As VbMsgBoxResult alert = MsgBox("行政報告を保存します。", vbYesNo + vbQuestion, "行政報告確認") If alert <> vbYes Then Exit Sub End If Application.ScreenUpdating = False Dim folder As String folder = "\\Nas-sp01\share\確認部\行政報告フォルダ\☆確認済交付月別物件(完了検査対象)\" & Worksheets("選択シート").Range("E4").Text & " 【担当】確認番号 建物名称\" & Worksheets("選択シート").Range("E3").Text & "\" Dim initName As String initName = folder & Worksheets("【標準】第1号様式").Range("Z1").Value Dim newName As String newName = initName & ".xlsm" Dim thisBk As Workbook Dim copyBk As Workbook Set thisBk = ActiveWorkbook ThisWorkbook.SaveCopyAs newName Set copyBk = Workbooks.Open(newName) Dim ws As Worksheet Dim TargetCheck As String Dim List As Variant Dim i As Long Dim Chk As Boolean List = Array("休日", "受付", "管理表", "300") For Each ws In copyBk.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 copyBk.Close SaveChanges:=True Application.ScreenUpdating = True End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/03/27 14:27 質問者: エクセル小僧
ベストアンサー
1
0
-
Sub 要具ライフ() ActiveSheet.Cells.Find(what:="TOPゴム").
Sub 要具ライフ() ActiveSheet.Cells.Find(what:="TOPゴム").offset(0,3) = ActiveSheet.Next.Cells.Find(what:="TOPゴム").Offset(0, 3).Value + 1 End Sub 上記のコードで、選択している隣のシート中にある特定の文字の下のセル内の数値に加算した値を選択しているシート中の同じ文字の下のセルに入れたいのですが実行できません。 シートを新しく作った時、隣のシートの行数が挿入するなどで変更される場合があるため行位置が一定でありません。よって、特定の文字のセル位置から出力するセルを探したいです。 どなたか、教えていただけないでしょうか?
質問日時: 2024/03/27 11:57 質問者: かなもゆ
ベストアンサー
2
0
-
エクセルのマクロについて教えてください。
下記のマクロは以前教えて頂いたマクロを少しアレンジして設定しております。 マクロを実行すると、ダイアログが開き、指定フォルダに指定セル値名でマクロ有効ブックで保存できます。 保存後に、元のマクロ有効ブックが閉じるようになっております。 マクロ実行前のファイルもマクロ有効ブックです(マクロ有効テンプレートではありません) しかし、マクロを実行すると、画像のようなエラーメッセージが表示され、 コードの「For i = 0 To UBound(List)」部分が黄色くなっております。 この問題の解決方法を教えて 現状のマクロ Sub 昇降機青紙保存() Dim alert As VbMsgBoxResult alert = MsgBox("【青紙】保存を行いますか?", vbYesNo + vbQuestion, "【青紙】保存確認") If alert <> vbYes Then Exit Sub End If On Error Resume Next Application.DisplayAlerts = False Dim vDeleteSheet As Variant On Error GoTo 0 Application.ScreenUpdating = False Const folder As String = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\" Dim newName As Variant Dim initName As String initName = folder & Range("CQ1").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 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 以上となります。 よろしくお願いいたします。
質問日時: 2024/03/26 18:09 質問者: エクセル小僧
ベストアンサー
2
0
-
VBA listBoxについて
動作としてはTextBox1に検索対象(管理№例100053)を入力(完全一致ではなく一部入力でも)該当する№がリストボックスに表示します 表示したリストから該当の№をクリックしたらsheet1のB列にカーソルが移動した対象を確認、 その№行の指定したセルに転記させるというながれになります 検索対象の桁数があるので下桁でも表示はするのですが クリックしてカーソルがその対象とは違うところに移動してしまいます 問題なく動くときは頭の1桁検索しスクロールで対象をクリックした時になります 現状はこのようになってます どのようにしたら改善するのでしょうか?(´;ω;`) Private Sub TextBox1_Change() ' TextBox入力した時の処理 Dim i As Long Dim Mydata As Variant Dim lastRow As Long Dim Cnt As Long Dim searchTerm As String Dim listBoxIndex As Integer ' 配列カウント初期化 Cnt = 1 ' 最終行を取得 lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 2).End(xlUp).Row ' 2次元配列の要素数を変更 ReDim Mydata(1 To lastRow, 1 To 20) ' 検索対象が空の場合は処理を終了 searchTerm = Me.TextBox1.text If Len(searchTerm) = 0 Then Exit Sub For i = 1 To lastRow If InStr(1, Sheets("Sheet1").Cells(i, 2), searchTerm) > 0 Then ' 配列に列の値と、セル番号を格納 Mydata(Cnt, 1) = i + 1 Mydata(Cnt, 2) = Cells(i, 2) Mydata(Cnt, 3) = Cells(i, 3) Mydata(Cnt, 4) = Cells(i, 4) Mydata(Cnt, 5) = Cells(i, 5) Mydata(Cnt, 6) = Cells(i, 6) Mydata(Cnt, 7) = Cells(i, 7) Mydata(Cnt, 8) = Cells(i, 8) Mydata(Cnt, 9) = Cells(i, 9) Mydata(Cnt, 10) = Cells(i, 10) Mydata(Cnt, 11) = Cells(i, 11) Mydata(Cnt, 12) = Cells(i, 12) Mydata(Cnt, 13) = Cells(i, 13) Mydata(Cnt, 14) = Cells(i, 14) Mydata(Cnt, 15) = Cells(i, 15) Mydata(Cnt, 16) = Cells(i, 16) Mydata(Cnt, 17) = Cells(i, 17) Mydata(Cnt, 18) = Cells(i, 18) Mydata(Cnt, 19) = Cells(i, 19) Mydata(Cnt, 20) = Cells(i, 20) ' 他の列のデータも同様に追加 ' ... ' 配列カウント増加 Cnt = Cnt + 1 End If Next i ' 検索で一致したデータをリストボックスに表示 With ListBox1 .ColumnCount = 20 .ColumnWidths = "30;55;40;0;150;90;130;130;0;0;60;150;0;0;0;0;120,60,130,30" .List = Mydata End With End Sub Private Sub ListBox1_Click() ' リストボックス内をクリックして該当セルを選択 Dim rowIndex As Integer Dim targetCell As Range ' 選択された項目の行番号を取得 rowIndex = ListBox1.ListIndex + 2 ' 対応するセルを選択 Set targetCell = Sheets("Sheet1").Cells(rowIndex, 2) targetCell.Select End Sub Private Sub CommandButton1_Click() Dim selectedRow As Integer Dim r As Integer If Me.ComboBox6 = "" Then MsgBox "管理場所が入力されてません" Exit Sub End If If Me.ComboBox7 = "" Then MsgBox "担当者が入力されてません" Exit Sub End If ' リストボックス内で選択された行のインデックスを取得 selectedRow = ListBox1.ListIndex For r = 2 To Cells(Rows.Count, "B").End(xlUp).Row If ListBox1.ListIndex = r - 2 Then ' 選択された行が有効かどうかを確認 ' 選択された行に基づいてデータを転記 Cells(r, 18).Value = Me.TextBox4.Value Cells(r, 19).Value = Me.ComboBox6.Value Cells(r, 20).Value = Me.ComboBox7.Value Cells(r, 21).Value = Me.TextBox2.Value ' 選択された行をリストボックスから削除 ListBox1.RemoveItem r - 2 Exit For ' 処理が完了したらループを終了 End If Next r End Sub
質問日時: 2024/03/26 16:14 質問者: kacky76
ベストアンサー
2
0
-
VBAを使用した時間管理
ある列(例:C列)に文字列(例:開始、終了)が入力されたら右横のセルに入力された時間表示し、整数が入力された場合は左横のセルに日付を表示させたいです。開始、終了、整数はバーコードリーダーを使用してQR化した文字列、数字を取得する予定です。 ご回答よろしくお願いします。
質問日時: 2024/03/25 12:45 質問者: かずよこ
解決済
4
0
-
左右の表のキー位置を合わせたい
左表と右表がありますが、キーがあったりなかったりして行が ずれているのを一致させた表をつくろうとしています。 キーの有無を判定して相手方の表に空行を挿入する方法以外で もっと良い方法はありませんか?
質問日時: 2024/03/25 10:23 質問者: rexfan
解決済
4
0
-
エクセルVBAにて =A1=B1とすれば A1とB1のセル内容が一緒だった場合 TRUE 違っていれ
エクセルVBAにて =A1=B1とすれば A1とB1のセル内容が一緒だった場合 TRUE 違っていれば FALSE になる。 上と似たようにA列とB列が一緒だった場合 TRUE 違っていれば FALSE ←この列での判定はできるのでしょうか? また、あればVBAでこの列での判定があればコードを教えていだきたいです。
質問日時: 2024/03/24 19:05 質問者: 社畜お兄さん
ベストアンサー
2
0
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
メダロット:第243話「Vol.243※期間限定公開」
天才メダロッター六葉カガミの戦いを描く「メダロット再~リローデッド~」(漫画:伯林、監修:イマジニア)、20周年を迎えた『メダロット』が新たなストリーでココに再起動!!★全話無料で読める、週刊メダロット通信...
-
SNSでの誹謗中傷はなぜなくならない?自分で自分を守るための利用方法とは!
今や世の中は「SNS全盛時代」といっても過言ではない。さまざまな情報を得られる半面、誹謗中傷などの不適切な投稿が人の心を傷つけるケースも少なくない。諸刃の剣ともいえるSNSだが、「教えて!goo」 には「ネット...
-
賃貸を退去する際の通常損耗の回復費用は誰が負担?契約時に注意すべき点は?
「退去時における消耗箇所の回復費用を誰が負担するか」というのは、賃貸物件のよくあるトラブルであるが、そもそも通常消耗・経年劣化・特別消耗の意味がそれぞれ異なることはあまり知られていない。 ・通常消耗・...
-
メダロット:第242話「Vol.242※期間限定公開」
天才メダロッター六葉カガミの戦いを描く「メダロット再~リローデッド~」(漫画:伯林、監修:イマジニア)、20周年を迎えた『メダロット』が新たなストリーでココに再起動!!★全話無料で読める、週刊メダロット通信...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA指定行削除
-
VBA一覧取得 再投稿
-
VBAコンボボックスで選択した値をシ...
-
エクセルVBAについて
-
【ExcelVBA】値を変更しながら連続...
-
FileCopy時のエラー
-
VBA 複数のエクセルから一つのエク...
-
VBA ユーザーフォーム ボタンクリッ...
-
コードを直していただきたいです。 ...
-
2つのマクロでチェックボックスが連...
-
VBAに詳しい方教えてください。
-
ExcelのVBAコードについて教えてく...
-
VBA listBoxについて
-
VBA実行後に元のセルに戻りたい
-
Vba 実数および実数タイプの変数に...
-
エクセルVBAについて
-
現在のブックを閉じないで、マクロ...
-
Excel VBA 定義されたプロージャ名...
-
エクセルのマクロについて教えてく...
-
Excelのマクロについて教えてくださ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel VBA 定義されたプロージャ名...
-
Excel-VBAのmsgBox()の不思議
-
【VBA】マクロの入ったファイルと同...
-
VBA 複数条件の分岐処理の上手な方法
-
現在のブックを閉じないで、マクロ...
-
VBAで各列の"+"と"o"の合計数を数え...
-
VBAに詳しい方教えてください。
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
ユーザーフォームに別シートからデ...
-
エクセルのマクロについて教えてく...
-
ExcelVBA シート名を複数セルから取...
-
エクセルのマクロについて教えてく...
-
VBA listBoxから
-
Excelのマクロについて教えてくださ...
-
エクセルのマクロについて教えてく...
おすすめ情報