回答数
気になる
-
VBAでCOPYを繰り返すと、処理が途中でアイドルする原因はなんでしょうか
A列からE列までの5列で約3000行のデータがあります。これらのデータは2つのグループのデータが混在しています。それをグループ毎に振り分ける処理を作成しました。処理は正常に動作したのですが、処理に数分程度かかりました。 そこで50行毎の処理時間をセルに表示させるようにしたところ、700行程度までは数秒で処理できていますが、その後1分程度、処理がアイドルしています。その後また700~800行を数秒で処理し、またアイドルするの繰り返しでした。 解決策は見つけましたが、処理がアイドルする原因は何として考えられるか、教えていただけませんか。これまでこのような現象は経験がなく、気になっています。よろしくお願いいたします。 問題のステートメント Cells(idx, 1).Resize(1, 5).Copy Destination:=Cells(cntA, 7).Resize(1, 5) Application.CutCopyMode = False ' ← この行は、あってもなくても現象は変わらない なおCopyメソッドをやめて、地道に転記してみたら10秒程度で全ての処理が終わりました。 Cells(cntA, 7) = Cells(idx, 1) Cells(cntA, 8) = Cells(idx, 2) Cells(cntA, 9) = Cells(idx, 3) Cells(cntA, 10) = Cells(idx, 4) Cells(cntA, 11) = Cells(idx, 5) Windows10 Office Professional Plus 2019 です。
質問日時: 2024/06/27 13:21 質問者: zap35
ベストアンサー
4
1
-
vbaにてseleniumを使用したedgeスクレイピング
vbaにて selenium basicを使用して edgeブラウザを操作しようとしています。 vbaからedgeを起動しようとしていますが vbaにて、Selenium.Webdriverをnewする行で、オートメーションエラー('-2146・・・')となります。 ◆下記、手順を実施 1)SeleniumBasic-2.0.9.0インストール 2).net Framework3.5有効化 3)edgedriverダウンロード seleniumのフォルダに上書き *バージョンは使用中のedgeブラウザの バージョンと同じにしてます 4)vba の参照設定追加 Selenium Type Libraryをチェック 5)vbaコード作成と実行 sub Dim driver As Selenium.WebDriver Set driver = new Selenium.WebDriver driver.Start "edge" End Sub ◆実行環境 Windows Home 11 23H2 64bit excel 2003 ◆補足 ・手順4の参照設定画面にて Selenium Type Libraryの場所に表示される ファイル名がselenium32.tlb(selenium64.tlbではない) とあり、気になりますが、変更できませんでした。 seleniumのフォルダにはselenium64.tlbも存在はしています。
質問日時: 2024/06/27 11:09 質問者: ゆu
解決済
1
0
-
ベストアンサー
3
0
-
テキストファイルのフィールド行のみ削除したい
CSVファイルのフィールド行のみを削除する方法を教えてください。 PADからの実行で実行可能なスクリプトは以下です。 ・DOSコマンド ・VBScript ・JavaScript ・Python これらであればどれを使用しても大丈夫です。 よろしくお願いします。
質問日時: 2024/06/25 11:20 質問者: Mehco3
解決済
2
0
-
Excel(M365) Vlookup/セル反転(VBA)について
・Excel(M365)で、添付ファイルのようなVLOOKUP処理を作りたい(VBAで)のですが、作り方についてお教えいただけませんでしょうか ・具体的に実施したいこととしては、①Sheet1のE列と、Sheet2のC列をマッチングし、Sheet1のJ列の値を、Sheet2のM列へ転記する。その際、Sheet1にデータ重複している場合(例:CCC,DDD)、そのデータの最下行の値を転記する(例:CCC→400、DDD→700)②この重複データについては、アラームのため、該当するSheet2のB~C列を赤くセル反転させる。 ・上記マッチングしない場合は、Sheet2へは特に転記はしない(例:EEE) ・何卒、よろしくお願いします。
質問日時: 2024/06/24 08:11 質問者: mame1216
解決済
1
0
-
Excel 範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが
Excel 範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが、自動化する方法はありますでしょうか? 流れとしては下記のような順序になります。 スクショ写真を貼り付けるセルを選択 ※ここはまだ手動です。 ↓ 自動:範囲指定のスクショ機能を動作させる ↓ 自動:範囲指定した箇所をスクショ ※指定する範囲は毎回同じです。 ↓ 自動:選択しているセルに貼り付け 文頭に(自動:)とついている文が自動化させたいところです。 分かる方いましたら、ご回答お願いします
質問日時: 2024/06/22 22:07 質問者: ピーマンナッツ
解決済
1
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると 連続して指定マクロが実行されます。 しかし、 マクロ「フォルダコピー新規」を実行した後に「戸建てファイルコピー」を実行すると それぞれ保存先を聞いてきます。 マクロ「戸建てファイルコピー」の場合は保存先を聞いてこず、「フォルダコピー新規」で指定したフォルダ内に保存出来る方法を教えてください。 現状のマクロ Sub 新規引き受け() Call フォルダコピー新規 Call 戸建てファイルコピー End Sub それぞれのマクロ Sub 戸建てファイルコピー() Const FileNewName As String = "総合引き受け(戸建て)" Dim Destinationfolder As Variant With Application.FileDialog(msoFileDialogFolderPicker) .Title = "保存先フォルダを選択してください" .InitialFileName = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\" If .Show = False Then Exit Sub Destinationfolder = .SelectedItems(1) End With Dim SourceFile As String Dim Extension As Variant For Each Extension In Array(".xlsm", ".xltm") SourceFile = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\審査用フォルダ\総合引き受け(戸建て)" & Extension Dim DestinationFile As String DestinationFile = Destinationfolder & "\" & FileNewName & Extension On Error Resume Next FileCopy SourceFile, DestinationFile On Error GoTo 0 Next End Sub と Sub 戸建てファイルコピー() Const FileNewName As String = "総合引き受け(戸建て)" Dim Destinationfolder As Variant With Application.FileDialog(msoFileDialogFolderPicker) .Title = "保存先フォルダを選択してください" .InitialFileName = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\" If .Show = False Then Exit Sub Destinationfolder = .SelectedItems(1) End With Dim SourceFile As String Dim Extension As Variant For Each Extension In Array(".xlsm", ".xltm") SourceFile = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\審査用フォルダ\総合引き受け(戸建て)" & Extension Dim DestinationFile As String DestinationFile = Destinationfolder & "\" & FileNewName & Extension On Error Resume Next FileCopy SourceFile, DestinationFile On Error GoTo 0 Next End Sub になります。 宜しくお願い致します。
質問日時: 2024/06/21 09:31 質問者: エクセル小僧
ベストアンサー
4
0
-
プログラミング
おはようございます。 今日もB型事業所に通う私です。 アイスコーヒーを飲んでいます。 最近、エクセルVBAを始めたのですが楽しいです。 プログラミングって楽しいですよね?
質問日時: 2024/06/20 07:01 質問者: ともこん
ベストアンサー
6
0
-
エクセルVBAコードで教えて下さい!
現在 、 Sub 円楕円1_Click() Dim i As Range Set i = ActiveCell With ActiveSheet.Shapes.AddShape(msoShapeOval, i.Left, i.Top, i.Width, i.Height) .Fill.Visible = False .Line.ForeColor.RGB = RGB(0, 0, 0) End With Set i = Nothing End Sub 上記コードで該当(土日)に〇を付けて編集しています。 このコードを結合したセルにも使えるようにするには、どのようにコードを編集すれば 良いでしょうか? ご教授のほどよろしくお願いいたします。
質問日時: 2024/06/18 17:28 質問者: TAKA0315m
ベストアンサー
1
0
-
VBAコードについて教えてください。
作業ブックのシートに下記のコードを設定しております。 このコードは指定セルに("地番調査", "許可証")のどちらかの文字が表示された場合に 文字が表示された右横のセルに「後日図書の提出をお願いいたします。」 と表示されます。 このコードを変更して 指定セルに不特定な文字が表示された場合に 右横のセルに「後日図書の提出をお願いいたします。」 と表示出来る方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("C26:C31")) Is Nothing Then Exit Sub Dim arr1, arr2 arr1 = Array("地番調査", "許可証") Dim i As Long For i = 0 To UBound(arr1) If Target.Value = arr1(i) Then Target.Offset(, 3).Value = "後日図書の提出をお願いいたします。" Exit Sub End If Next i End Sub 以上です。 宜しくお願い致します。
質問日時: 2024/06/18 13:51 質問者: エクセル小僧
ベストアンサー
2
0
-
Excelのマクロについて教えてください。
下記のマクロはネットで調べたコードを自分用にアレンジした、マクロです。 このマクロを実行すると、マクロ設定ブックと同じフォルダ内にある、別ブックの指定シートの指定セル値を作業ブックにコピぺできます。 しかし、マクロを実行すると、画像のエラーメッセージが表示され、作業ブックのコピー先のシート「受付」に設定しているVBAコード「With Worksheets("審査")」が黄色く変色してしまいます。 このコード全体では Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As Variant Dim i As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False tbl = Array("D10", "D11", "E10", "E11", "F10", "F11") With Worksheets("審査") For i = 0 To 5 .Range("C" & 26 + i).Value = Range(tbl(i)).Value If Range(tbl(i)).Value = "" Then .Range("F" & 26 + i).Value = "" Else .Range("F" & 26 + i).Value = "後日図書の提出をお願いいたします。" End If Next i End With 以下省略 End Sub となっており、指定セル値に文字が表示されれば、シート名「審査」の指定セルに「後日図書の提出をお願いいたします。」と表示出来るようになっております。 この問題を解決できる方法を教えてください。 現状のマクロ Sub Macro1() Dim FilePath As String 'ファイルの入っているフォルダをパスを設定 FilePath = ThisWorkbook.Path 'コピー元のブックを開く Workbooks.Open FilePath & "\テスト(提出用).xlsx" 'データをコピー Workbooks("テスト(提出用).xlsx").Worksheets("提出シート").Range("B2:H47").Copy _ Workbooks("総合引き受け(1-1)(知恵袋).xlsm").Worksheets("受付").Range("B2") 'コピー元のブックを閉じる(セーブしない) Workbooks("テスト(提出用).xlsx").Close savechanges:=False End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/06/18 09:20 質問者: エクセル小僧
ベストアンサー
1
0
-
vba アクティブシートの名前変更について教えてください
いつもお世話になります 今同じシート名の存在を確認して、同じ名前のシート名が有る時は削除してから シートを追加し、名前を変更するステートメントを作成しています File2="WC(品)" For Each ws In Worksheets If ws.Name = FILE2 Then Application.DisplayAlerts = False Worksheets(ws.Name).Delete Application.DisplayAlerts = True Exit For End If Next ws Worksheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = FILE2 既存のシートには前回作った"WC(品)"が有ったのですが シートの有無チェックには掛からずに下記のエラーが発生しました エラー:"この名前は既に使用されています。別の名前を入力してください" エラーが出たときはちょっとびっくりしました。 今はStrConvを使ってエラーを回避させていますがちょっと気に掛かるので教えてください ActiveSheet.Nameは全角と半角の区別は出来ないのでしょうか? 以上、よろしくお願い申しあげます
質問日時: 2024/06/17 12:27 質問者: 公共ごま
ベストアンサー
3
0
-
Excelのマクロについて教えてください。
作業ブックに連続して実行できるマクロを設定しております。 Sub 貼り付け総合() Call 提出シートを開く Call 提出シートコピー範囲 Call 貼り付け End Sub このマクロを実行すると画像のエラーが表示されて、 マクロ:「貼り付け」のコードの 「Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats」が黄色く表示されて、上手くマクロが実行できません。 例えば、「Call 提出シートを開く」・「Call 提出シートコピー範囲」のマクロをやめて 手動でコピー元のブックを開き、コピー範囲をマウスで設定して「Ctrl+C」を行い 作業ブック側の「Call 貼り付け」を実行するとコピペが上手く行きます。 問題の解決方法を教えてください。 現状のマクロ Sub 提出シートを開く() On Error Resume Next Dim folderPath As String Dim fileName As String folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*(提出用).xlsx") Do While fileName <> "" Workbooks.Open (folderPath & fileName) fileName = Dir() Loop End Sub Call 提出シートコピー範囲 Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Wb2.Worksheets("提出シート").Range("B1:H47").Copy End Sub Sub 貼り付け() Application.DisplayAlerts = False Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.DisplayAlerts = True Sheets("受付").Range("H60").Copy Sheets("受付").Range("F24").PasteSpecial xlPasteValues Sheets("受付").Range("Q10").Copy Sheets("受付").Range("F12").PasteSpecial xlPasteValues End Sub 以上となります。よろしくお願いいたします。
質問日時: 2024/06/14 16:38 質問者: エクセル小僧
ベストアンサー
2
1
-
エクセルのマクロについて教えてください。
下記のマクロは別ブックの指定セル値を作業ブックに貼り付け出来るマクロとなっております。 この貼り付けを画像のように「値の貼り付け」「値と数値の書式(A)で 貼り付けが出来る方法を教えてください。 現状のマクロ Sub 貼り付け() Application.DisplayAlerts = False Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.DisplayAlerts = True End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/06/14 12:16 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
コピー先のマクロ設定作業ブックを「Set Wb1 = Workbooks(1) 'このブック」としており コピー元のブックを「Set Wb2 = Workbooks(2) '別ブック」としております。 現状では、 コピー元のシート名「提出シート」のセル範囲「B1:H47」を手動で B1にセルからH47にセルを合わせて「Ctrl+C]を押してコピー範囲を指定しております。 この作業を コピー先の作業ブック「Set Wb1 = Workbooks(1) 'このブック」にマクロを設定できる方法を教えてください。 一番最初に「Set Wb1 = Workbooks(1) 'このブック」を開き、 次に 「「Set Wb2 = Workbooks(2) '別ブック」 を開いております。 新設にコード共、教えてください。 よろしくお願いいたします。
質問日時: 2024/06/13 15:48 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると 他のブックの指定範囲を作業ブックの指定範囲にコピペできます。 このマクロだとコピー元のセル値に設定している数式を文字としてコピーしてしまいます、 このコードを変更してコピペした場合に、コピー元のセル値に表示した文字及び数式をコピー先にコピペ出来る方法を教えてください。 現状のマクロ Sub 提出シート貼り付け() Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Wb2.Worksheets("提出シート").Range("B1:H37").Copy Wb1.Worksheets("受付").Range("B1:H37") End Sub 以上です。 よろしくお願いいたします。
質問日時: 2024/06/13 13:39 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
下記のマクロを実行するとマクロを設定しているブックと同じフォルダ内にある ファイルを開く事が出来ます。 ファイル名「前青紙.xlsx」この部分をワイルドカードで 「*(提出用).xlsx」に変更する方法を教えてください。 現状のマクロ Sub ブックを開く2() On Error Resume Next Workbooks.Open Filename:=ThisWorkbook.Path & "\前青紙.xlsx" End Sub 以上です。よろしくお願いいたします。
質問日時: 2024/06/13 10:35 質問者: エクセル小僧
ベストアンサー
2
0
-
Excelのマクロについて教えてください。
下記のマクロを実行すると指定のファイルのデーターを 作業ブックの指定シートに貼り付けが出来るようにしております。 作業ブックでこのマクロを実行するとかなりの時間がかかります(20秒程度) この時間を短縮できる方法があれば教えてください。 現状のマクロ Sub データコピペ() Dim expressionRng, destinationRng Dim n 'コピー元のファイルを開く Workbooks.Open ActiveWorkbook.Path & "\" & "FDデータ.xlsx" Set expressionRng = Workbooks("FDデータ.xlsx").Sheets("Sheet1").Range("$A$1:$OZ$12") Set destinationRng = ThisWorkbook.Sheets("FDデータ").Range("$A$1:$B$2") For n = 1 To expressionRng.Rows.Count destinationRng(n, 1).RowHeight = expressionRng(n, 1).RowHeight Next For n = 1 To expressionRng.Columns.Count destinationRng(1, n).ColumnWidth = expressionRng(1, n).ColumnWidth Next expressionRng.Copy destinationRng Workbooks("FDデータ.xlsx").Close Kill ActiveWorkbook.Path & "\" & "FDデータ.xlsx" End Sub よろしくお願いいたします。
質問日時: 2024/06/13 08:57 質問者: エクセル小僧
ベストアンサー
5
0
-
久しぶりのプログラミング
おはようございます。 今日もB型事業所に通う私です。 昨日からエクセルVBAを始めました。 私にとっては久しぶりのプログラミングです。 大学行って、専門学校でプログラマを目指していたので、比較的やりやすいです。 私は当時、C言語を学んでいたのですがそれに比べるとVBAは楽と言うか 始めたばかりなのでわかりませんがやりやすいです。 今、Cをやるとするとコンパイラがないし、かなり忘れています。 VBAはエクセルなので特別なソフトがいらないのでいいです。 普段、エクセルは実用的に表などを作っているので、VBAプログラミングは趣味のような ものです。 プログラミングって楽しいですよね!! やっている方どうですか?
質問日時: 2024/06/13 06:56 質問者: ともこん
ベストアンサー
4
1
-
エクセルVBA
つい先ほど、久しぶりに本を見つけました。 エクセルVBAの本です。 古い本でしたがサンプルファイルはダウンロードしてありました。 私は、プログラミングは正直、C言語とHTMLがある程度出来るのでなんとなくコツはつかみました。 エクセルを最初からVBEで入力し、デバックして実行し、マクロすれば良いのですよね? 詳しい方、教えてください。
質問日時: 2024/06/12 19:38 質問者: ともこん
ベストアンサー
3
0
-
Excelのマクロについて教えてください。
下記のマクロは先日教えて頂いた、マクロです。 コピー元の指定フォルダ内の指定ファイル名「■北海道_20230731更新.pdf」の 「_20230731更新」この部分が点検終了日付をしてしており、都度、変更になります。 ワイルドカードを利用して「■北海道*」をコピー先にコピー出来る方法を教えてください。 又、コピー後は元のファイル名+「_Copy.pdf」となるようにお願いいたします。 現状のマクロ Sub 北海道条例() On Error Resume Next Dim targetCities As Variant Dim city As String Dim isExcluded As Boolean Dim copyFilePath As String Dim destinationFilePath As String ' 特定の都市名リスト targetCities = Array("旭川市", "釧路市", "札幌市", "室蘭市", "小樽市", "帯広市", "苫小牧市", "函館市", "北見市") ' セル F3 の都市名を取得 city = Sheets("受付").Range("F3").Value ' 都市名がリストに含まれているかどうかをチェック isExcluded = False For Each c In targetCities If city = c Then isExcluded = True Exit For End If Next c ' リストに含まれていない場合 If Not isExcluded Then ' コピー元のファイルパス copyFilePath = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\■北海道_20230731更新.pdf" ' コピー先のファイルパス destinationFilePath = ThisWorkbook.Path & "\■北海道_20230731更新_Copy.pdf" ' ファイルをコピー FileCopy copyFilePath, destinationFilePath End If End Sub 以上となります。 よろしくお願いいたします。
質問日時: 2024/06/12 10:41 質問者: エクセル小僧
ベストアンサー
1
0
-
Excelのマクロについて教えてください。
Excelのマクロについて教えてください。 下記のマクロは先日教えて頂いたマクロです。 このマクロを利用して下記のように変更出来る方法を教えてください。 セル「F3」に 「旭川市・釧路市・江別市・札幌市・室蘭市・小樽市・帯広市・苫小牧市 函館市・北見市」以外の表示があった場合は、 コピー元のファイル「■北海道北海道_20230731更新」が作業フォルダ内にコピー出来る方法を教えてください。 例えば、F3に「北広島市」と表示されると フォルダ内に「■北海道_20230731更新_Copy.pdf」がコピー出来る方法を教えてください。 現状のマクロ Sub 条例() On Error Resume Next If Sheets("受付").Range("F3").Value <> "" Then Const copy_path As String = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\" Dim strSource As String strSource = Dir(copy_path & "■" & Sheets("受付").Range("F3").Value & "*.pdf") FileCopy copy_path & strSource, _ ThisWorkbook.Path & "\" & Mid(strSource, 1, InStrRev(strSource, ".") - 1) & "_Copy.pdf" End If End Sub 以上となります。よろしくお願いいたします。
質問日時: 2024/06/11 17:23 質問者: エクセル小僧
ベストアンサー
1
0
-
VBAなくなるの?
VBAがなくなる、使えなくなると言う記事なりユーチューブを見たのですが本当でしょうか? 今でも仕事でVBAを使っているのですが使用できなくなるってこと? もしそうなら今後はなにで代用できますか?詳しい方いれば教えて下さい。 早めに勉強しようと思いますので勉強方法なども教えてくださると助かります。
質問日時: 2024/06/09 11:28 質問者: ケイ0000
ベストアンサー
3
0
-
vba 削除
質問ですシートに値の一覧が複数あります。それを条件に基づいて行を削除したいです。 条件ですが画像の2行目、3行目のようにa2、b2、c2、a3、b3、c3セルの内容が同じでd2が空白、d3は文字が入っています。この2行がペアでe列が両方okなら合格で5行目、6行目のように片方にngがあればそのペアは不合格です。この条件でシートに一覧で並んでいるものを振り分けて不合格ならそのペアの両方の行を削除するVBAを作りたいです。初めはngを検索して削除していたのですがそれだとokが残ってしまいますがペアで揃って合格なので一つだけしかないものも削除したいです。 説明が難しいのとヘタでわかりにくいと思いますが、理解してくださった方おられれば教えて下さい
質問日時: 2024/06/04 21:05 質問者: ケイ0000
解決済
3
0
-
Geogebraの操作方法について
Geogebraにおいて、写真のように変数のもつ値に対応して、aの値が変わるような式のテキストを作成したいです。 見よう見まねで作っても、[a]としか表示されず、変数として表示が反映されません。 どうすればいいのでしょうか
質問日時: 2024/06/01 11:13 質問者: みなゆう
解決済
1
0
-
ExcelのVBAコードについて教えてください。
Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As Variant Dim i As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False tbl = Array("D10", "D11", "E10", "E11", "F10", "F11") With Worksheets("審査") For i = 0 To 5 .Range("C" & 26 + i).Value = Range(tbl(i)).Value If Range(tbl(i)).Value = "" Then .Range("F" & 26 + i).Value = "" Else .Range("F" & 26 + i).Value = "後日図書の提出をお願いいたします。" End If Next i End With On Error Resume Next Sheets("消防添").Visible = [R37] = "消防添" 途中省略 Sheets("INDX").Visible = [D2] = "電子申請" 下記のコードもいくつか途中省略しております。 If Range("D2").Value = "紙申請" Then Call 電図 Else Call 紙図 End If If Range("N41").Value = "■" Then Call 注意1表示 End If If Range("D7").Value = "計画変更" Then Call 注意3表示 End If If Range("N44").Value = "■" Then Call 注意4表示 End If If Range("D5").Value = "車庫等:単独" Then Call 車庫単独 End If If Range("R55").Value = "車庫注意" Then Call 車庫単独 End If If Range("D7").Value = "計画変更" Then Call 計変画像表示 End If If Range("Q27").Value = "■" Then Call 区分図形表示 End If If Range("D12").Value = "有" Then Call 消防表示 End If If Range("F13").Value = "有" Then Call 浄化槽表示 End If If Range("F8").Value >= 3 Then Call 通路 End If If Range("J16").Value = "消防同意必要" Then Call 消防貼り付け End If If Range("Q2").Value = "■" Then Call 市町村名コピー End If If Range("F3").Value = "旭川市" Then Call 旭川市図形表示 End If If Target.Address = "$C$20" Then Call 審査担当コメント非表示 End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Sub 以上となります。
質問日時: 2024/05/29 16:59 質問者: エクセル小僧
ベストアンサー
5
0
-
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
ピンとくる人とこない人の違いは?直感を鍛える方法を心理コンサルタントに聞いた!
根拠はないがなんとなくそう感じる……。そんな「直感がした」という経験がある人は少なくないだろう。ただ直感は目には見えず、具体的な説明が難しいこともあるため、その正体は理解しにくい。「教えて!goo」にも「...
-
中古物件転売時の節税対策にメス?不動産投資家は戦々恐々?元国税が解説
不動産の取引において、土地と建物を一括で売買する場合、土地に消費税はかからないが、建物には消費税がかかる。これを利用して、例えば土地と建物を合計1億円で売る場合、土地の値段を9999万9999円にし、建物を1円...
-
話題の「風呂キャンセル界隈」、お風呂に「入らない」のではなく「入れない」?
皆さんは、「風呂キャンセル界隈(かいわい)」という言葉を聞いたことはあるだろうか。「お風呂に入らない(入れない)人」のことで、最近ネット上などで話題になっているようだ。「教えて!goo」にも、「風呂に入...
-
マッチングアプリで出会ったカップルは成婚率が高い!?結婚カウンセラーに聞いてみた
パートナーとの出会いの場として、もはや主流となったネット婚活やマッチングアプリ。中でも手軽に登録できるマッチングアプリは、10代から50代と幅広い年代が利用している。一方で、“相手の目的が投資関係の詐欺や...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Web画面の文字をVB6で取得したい
-
【ExcelVBA】インデックスが有効範...
-
VBA 別ブックから条件に合うものを...
-
Excel VBA 文字列のセルを反映させ...
-
VB.net(VB)で、フォームにExcelファ...
-
配列のペースト出力結果の書式について
-
エクセルのマクロについて教えてく...
-
[VB.net] ボタン(Flat)のEnable時の...
-
vbaにてseleniumを使用したedgeスク...
-
メールの件名をデコードしたい
-
VBA 別ブックからコピペしたいので...
-
VBA実行後に元のセルに戻りたい
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
Excel-VBAのmsgBox()の不思議
-
郵便番号検索APIにてget ElementByT...
-
VBA 入力箇所指定方法
-
エクセルのマクロについて教えてく...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA 別ブックからコピペしたいので...
-
Vba ファイル書き込み時に書き込み...
-
Excel_VBAについて質疑です。(for...
-
VBAの間違い教えて下さい
-
VBA コードどこがおかしいですか?
-
VBA 円グラフ 特定条件に一致したデ...
-
VBA 別ブックから条件に合うものを...
-
pdfファイルの複数添付 引数の型
-
【ExcelVBA】インデックスが有効範...
-
ExcelVBAマクロで実行した時の疑問
-
Vba UserformからExcelシートのサイ...
-
VBA初心者です。次のVBAコードで、1...
-
Outlookの「受信日時」「件名」「本...
-
Excel 範囲指定スクショについて Ex...
-
vbs ブック共有を解除
-
配列のペースト出力結果の書式について
-
Excel VBAで値を変えながら、pdf出...
-
VB.net(VB)で、フォームにExcelファ...
-
vbaにてseleniumを使用したedgeスク...
-
ExcelVBA シート名を複数セルから取...
おすすめ情報