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

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

回答数

気になる

Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の

Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の条件は同じで2つ目の条件がSheet2のB列に20個縦に並んでいるのですが、下記のように同じようなマクロを20個書くのではなく抽出条件２をSheet2のB列から持ってくる方法を教えてください。 Sub りんごA() 　　　'オートフィルターで抽出　Dim Count As Long 　With Worksheets("Sheet3") '抽出条件1 Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues '抽出条件2 Range("B4").AutoFilter 6, "りんごA" 　Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1)) 　End With '処理月へ転記 Dim c As Long With Worksheets("Sheet1") For c = 3 To 14 '４月～3月の範囲 If .Cells(2, c).Value = Worksheets("Sheet1").Range("A2").Value Then Worksheets("Sheet2").Cells(3, c) = Count - 1 Exit For End If Next c '該当月の指定 End With Application.CutCopyMode = False End Sub Sub ばななA() 　　　'オートフィルターで抽出　Dim Count As Long 　With Worksheets("Sheet3") '抽出条件1 Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues '抽出条件2 Range("B4").AutoFilter 6, "ばななA" 　Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1)) 　End With

質問日時: 2023/01/12 23:40 質問者: momo_2123

ベストアンサー

4

0
Sheet2からオートフィルターで売上日を抽出した件数をカウントし、その件数をSheet1のセルB1

Sheet2からオートフィルターで売上日を抽出した件数をカウントし、その件数をSheet1のセルB1の日付と一致するセルへ入力したいのですが下記マクロで❶❷の状況で上手くいきません。 ❶データの個数は「11」なのに「１」となる ❷Sheet1のB1セルへ「2023/3/1」にすると「2023/2/1」に入力される何処を直したら良いか教えてください。 Sub Test1() Dim Count As Long Worksheets("Sheet2").Range("B4").AutoFilter 1, "<>" '抽出件数カウント Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1)) '処理月へ転記 Dim c As Long For c = 1 To 12 '４月～3月の範囲 If Cells(4, c).Value = Range("B1").Value Then Exit For Next c '該当月の指定 Worksheets("Sheet1").Cells(5, c) = Count - 1 Application.CutCopyMode = False End Sub

質問日時: 2023/01/12 12:24 質問者: momo_2123

ベストアンサー

2

0
このマクロの説明文を教えてほしいです。

Sub test() Dim tbl() As Variant Dim r As Long Dim c As Integer Dim buf(2) As Integer Dim i As Integer, j As Integer Dim ck As Boolean '右の表を配列へ i = -1 For c = 25 To 33 Step 4 For r = 3 To 11 i = i + 1 ReDim Preserve tbl(3, i) tbl(0, i) = Cells(r, c).Value tbl(1, i) = Cells(r, c + 1).Value tbl(2, i) = Cells(r, c + 2).Value tbl(3, i) = Cells(r, c + 3).Value Next r Next c '9～12列の値と配列を比較 For r = 3 To Cells(Rows.Count, 9).End(xlUp).Row If r Mod 13 <> 2 Then Erase buf For c = 9 To 11 If IsNumeric(Left(Cells(r, c).Value, 1)) Then buf(c - 9) = Cells(r, c).Value End If Next c ck = False For i = 0 To UBound(tbl, 2) If buf(0) = tbl(1, i) And buf(1) = tbl(2, i) And buf(2) = tbl(3, i) Then Cells(r, 8).Value = tbl(0, i) ck = True Exit For End If Next i If ck = False Then Cells(r, 8).Value = "notall" End If End If Next r End Sub

質問日時: 2023/01/12 09:17 質問者: ライザンバイア

解決済

1

0
WordのVBAについて

文章中とテキストボックス内の文字に対して、特定の言語の検索と検索結果に該当する文字にマーカーを引くVBAを作成したいのですが詳しい方ご協力お願いできませんでしょうか。文章中のみに検索しマーカーを引くのは、ネット検索でいくつかあったのですが、テキストボックス内を含めてできるものがなく・・・。私自身VBAに詳しくなくお教えいただきたいです。

質問日時: 2023/01/11 14:38 質問者: しろる

ベストアンサー

5

0
For～Nextステートメントの終了条件について

Visual Studio Community 2019 下記のFor文を実行すると、ループを抜けた時点で i=16となります。その理由が知りたいです。よろしくお願い致します。 Dim i As Integer Dim idx() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} For i = 0 To idx.Count Or 5 Console.Write(i & " ") Next i Console.WriteLine()

質問日時: 2023/01/08 18:36 質問者: tomoyochan

ベストアンサー

1

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

先日教えて頂きましたマクロを少し改良して Sub 行調整() Dim r As Range For Each r In Range("B26:B60,E26:E60") If WorksheetFunction.CountIf(r.Resize(, 4), "<>") > 0 Then r.Rows.AutoFit Else r.RowHeight = 27 End If Next End Sub があります。マクロを実行すると B26：B60、E26：E60までの行を文字数により自動で調整でき、空白のセルは27間隔になります。しかし、E45の部分が文字調整が出来ず、B45の文字数での調整になってしまいます。解決方法を教えてください。 E45はE45とF45とG45とH45もセルが結合されております。又、表はA46で終わっておりますが、場面によって行セルを挿入して増やしていく可能性があるため、行セル60まで設定しております。よろしくお願いいたします。

質問日時: 2023/01/06 08:39 質問者: エクセル小僧

ベストアンサー

2

1
VBA 最終行まで数式をコピーする

ご回答者様いつもお世話になっております。 VBAで最終行まで数式をコピーする質問です。 2個のマクロを知りたいです。 (ソースをお願いします） 1.同一シート内でA列の最終行まで数式を縦にドラック(コピー）するエクセルのシートで売価設定シートと社内マスタというシートがあります。売価設定シートのJ6からP6のセルに入っている数式及びR6からAFまでの数式をA列(JAN)の記載がある最終行までドラックを行いたいです。 (全て売価設定シートというシート名の中に数式は入っています） 2.異なるシートでA列の最終行まで数式を縦にドラック(コピー）するシート名が売価設定シートのA列(JAN)の記載がある最終行までをカウントし、シート名マスタのA2からAD列の数式をドラックしたいです。（シート名が売価せていシートのA列にJANが必ず記載されております）ソースを頂けると助かります。マクロ初心者ですが何卒宜しくお願い致します。

質問日時: 2023/01/03 15:44 質問者: 中小企業

解決済

3

0
エクセルVBAで教えて頂きたいのですが？

図の様に設定シートとSheet２があります。今このプログラムを使用していますが、未登録の場合は空欄になってしまいます。登録がない場合には未登録と表示させたいのですが、どの様に変更したらいいのか分かりません。教えて頂きたいのですがよろしくお願い致します。設定シートの範囲がA16～A25行目までの範囲と列はZ列までデーターは増やすことが出来ます Sub TEST() Dim s1 As Worksheet, s2 As Worksheet Dim i As Long, f As Range, lc As Range Dim c As Long, r As Long, d As String Set s1 = Worksheets("設定") Set s2 = Worksheets("Sheet2") Set lc = s1.Cells.SpecialCells(xlLastCell) c = lc.Column r = lc.Row For i = 2 To s2.Range("G2").End(xlDown).Row Set f = s1.Range(s1.Cells(1, "B"), s1.Cells(r, c)).Find(What:=s2.Cells(i, "G").Value, LookAt:=xlWhole) If Not (f Is Nothing) Then s2.Cells(i, "F").Value = s1.Cells(f.Row, "B").Value End If Next i End Sub

質問日時: 2022/12/31 20:28 質問者: kirakirafreedom

解決済

2

0
起動中のアプリ、ソフトの取得

エクセルVBAで、ユーザーフォームのリストボックスに現在起動中のアプリやソフト（最小化されてみえないものや、エクセルのウィンドウに隠れてみないもの）の一覧を表示させ、リストボックス上で選択した際にその選択したアプリ、ソフトを前面に表示させたいです。起動中のタスクを調べるコードなどはネット上に上がっていましたがそれだとバックグラウンドで動いているものなども読み取ってしまい求めている動作になりません。立ち上がっているが、最小化、ウィンドウ裏に隠れているものを前面に、といのが行いたいことです。どなたかご存知の方がいらっしゃれば宜しくお願いします。

質問日時: 2022/12/28 11:13 質問者: 優也。

ベストアンサー

3

0
worksheetFunctionクラスのVlookupプロパティを取得できませんエラーへの対応

こんにちは。Excel VBAで「worksheetFunctionクラスのVlookupプロパティを取得できません」というエラーが発生してしまっております。以下構文のどこかおかしなところをご指摘いただけないでしょうか。よろしくお願いします。 For i = 2 To Workbooks("WWW.xlsm").Worksheets("XXX").Cells(Rows.Count,8).End(XlDown).Row ActiveSheet.Cells(i,23).value = Application.WorksheetFunction.Vlookup(ActiveSheet.Cells(i,8),Workbooks("YYY.csv").Worksheets("ZZZ").Range("A2:C1000"),3,False) CellsとRangeが混じっていると問題なのでしょうか。 VBA素人にもかかわらずコード修正を求められており、参っております。。どなたか詳しい方、アドバイスをお願いします。。

質問日時: 2022/12/27 22:27 質問者: mame1216

ベストアンサー

3

0
なぜこんな初歩的なVBAのIf文でエラーか発生して使えないのか、全く理解出来ません。誰か助けてくださ

なぜこんな初歩的なVBAのIf文でエラーか発生して使えないのか、全く理解出来ません。誰か助けてください。

質問日時: 2022/12/26 23:27 質問者: ゴリゴリモリゴリ

解決済

7

0
Excel vba で1と10を正確に判断させる方法を教えてください。 TからU列に1と入力があれば

Excel vba で1と10を正確に判断させる方法を教えてください。 TからU列に1と入力があればＡに変換、10と入力があればＪに変換させたいのですが、下記のコードではうまくいかず、10なのにＡ0と表示されます。上手く1を、1として判断させるコードをご教示いただけないでしょうか？よろしくお願いします！！ Range(.Cells(2,”T”), .Cells(maxrow,”U”)).Replace What:=“1” , LookAt:=xlWhole, Replacement:=“A” Range(.Cells(2,”T”), .Cells(maxrow,”U”)).Replace What:=“10” , LookAt:=xlWhole, Replacement:=“J”

質問日時: 2022/12/26 16:54 質問者: mahi-mahi

解決済

3

0
Csvファイルの最終行を取得する構文はこれであっていますか？オブジェクトは、このプロパティまたはメソ

Csvファイルの最終行を取得する構文はこれであっていますか？オブジェクトは、このプロパティまたはメソッドをサポートしていません、とエラーが出てしまいます。正しい構文を教えてください。 Dim lstrow as long lstrow = workbooks(“XX.csv”).range(“a1”).end(xldown).row

質問日時: 2022/12/26 14:38 質問者: mame1216

ベストアンサー

3

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

先ほど行を自動調整できるマクロを教えて頂きました。 Sub 行調整() Dim r As Range For Each r In Range("B26:B37,B41:B42") If WorksheetFunction.CountBlank(r.Resize(, 4)) <> 4 Then r.Rows.AutoFit Else '34.5に戻す必要がある場合 'r.RowHeight = 34.5 End If Next End Sub このマクロは「セルを結合」にした場合には行が調整できないようです。指定セルが結合されていても上手く行が調整できる方法があれば教えてください。（例えればB26行のセルは：B26、C26、D26列とセルが結合されてB26になっております）よろしくお願いいたします。

質問日時: 2022/12/26 14:27 質問者: エクセル小僧

ベストアンサー

1

0
ExcelのVBAで教えてください。 Vlookupで、X X.value = applicatio

ExcelのVBAで教えてください。 Vlookupで、X X.value = application.worksheetfunction.vlookup(worksheets(“YY.csv”).range(“a2”),3,false) と言う構文をつくっていますが、インデックスが有効範囲にありません、と言うエラーが出ます。おかしな点があればご指摘をお願いします。

質問日時: 2022/12/26 13:40 質問者: mame1216

解決済

1

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

Excelの行を自動調整するマクロについて教えてください。マクロ Sub 行調整() ActiveWindow.SmallScroll Down:=15 Range("B26:E37").Select ActiveWindow.ScrollRow = 31 ActiveWindow.ScrollRow = 32 ActiveWindow.ScrollRow = 33 ActiveWindow.ScrollRow = 34 ActiveWindow.ScrollRow = 35 ActiveWindow.ScrollRow = 36 Range("B26:E37,B41:E42").Select Range("B41").Activate Selection.Rows.AutoFit End Sub があります、このマクロを実行すると指定セルすべてが「行の高さの自動調整」にて文字数により調整されます。文字が無い場合は全ての行が「高さ18.75（25ピクセル）」になります。元々の表内の指定セルの行幅は「高さ34.5（46ピクセル）」になっており、表の見栄え上の関係で指定セルに文字がある場合のみ「行の高さの自動調整」が出来、指定セルに文字が無い場合は「高さ34.5（46ピクセル）」のままにできる方法があれば教えてください。よろしくお願いいたします。

質問日時: 2022/12/26 12:05 質問者: エクセル小僧

ベストアンサー

1

0
ExcelVBAでDo Until loopのネスト、IF文を使って一致する物と一致しない物としたい

sheet1!a2:c5、sheet2!a2:c6を比較して、比較(シート)!d2:f8に、一致するする物は d2:f4、一致しないものはd6:f7と、Do Until loopのネスト、IF文を使って実現したいのですが、何回やっても、ループが回らず、上手く行きません。大変、お手数ですが、どなたか、ご存じの方、教えて頂けないでしょうか？コード↓ Option Explicit Sub test1() '比較sheet Dim i As Long, j As Long　’比較シートa2:c5に貼り付け With Sheets("sheet1").Range("a1").CurrentRegion.Offset(1, 0) .Resize(.Rows.Count - 1).Copy Sheets("比較").Range("a2") End With i = 2 Dim Flag As Long Flag = 0 j = 2 Do Until i > Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row Do Until j > Sheets("比較").Cells(Rows.Count, "a").End(xlUp).Row Flag = 0 If Sheets("比較").Cells(j, "a") = Sheets("sheet2").Cells(i, "a") Then Sheets("比較").Cells(j, "d") = Sheets("sheet2").Cells(i, "a") Sheets("比較").Cells(j, "e") = Sheets("sheet2").Cells(i, "b") Sheets("比較").Cells(j, "f") = Sheets("sheet2").Cells(i, "c") Flag = 1 i = i + 1 Exit Do j = j + 1 End If If Flag = 0 Then With Sheets("比較").Range("a1").CurrentRegion .Cells(.Rows.Count + 1, 4) = Sheets("sheet2").Cells(i, "a") .Cells(.Rows.Count + 1, 5) = Sheets("sheet2").Cells(i, "b") .Cells(.Rows.Count + 1, 6) = Sheets("sheet2").Cells(i, "c") j = j + 1 End With End If Loop Loop End Sub

質問日時: 2022/12/24 17:46 質問者: zzhikkkk

ベストアンサー

11

0
ダブルクリックでセルの色を変える

ダブルクリックで色を設定した下記のVBAで色付けされた表があります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If (Target.Column) = 1 And Target.Text <> "" Then With Target.Interior If .Color = RGB(0, 112, 192) Then .ColorIndex = xlNone Else .Color = RGB(0, 112, 192) End If Cancel = True End With End If End Sub これに加えて更にRGB(0, 112, 192)→RGB(252, 9, 0)→RGB(255, 255, 119)→色なしに変える方法を教えていただきたいです。

質問日時: 2022/12/24 15:52 質問者: mossa_2007

ベストアンサー

1

1
マクロ初心者の質問です。１．シートを開いてマクロを実行する場合、アクセスキーでAlt-L-PMとタ

マクロ初心者の質問です。１．シートを開いてマクロを実行する場合、アクセスキーでAlt-L-PMとタイプすればマクロ実行できることは知っていますが、事前に特定のシートを選択しておくことは必要でしょうか？それとも、マクロ内で特定のシートを選択しているため、特定のシートの事前選択は不必要でしょうか？

質問日時: 2022/12/23 10:08 質問者: Gorby

解決済

2

0
VBA GetAttrについて教えてください

いつもお世話になります今、GetAttr関数を使ってファイル名とフォルダ名を取得したいのですがファイル名が上手く取れませんそこで下記のテストを作ってみたところ、getAttrの返り値がvbNormalにならずに vbArchive=32になっています Sub test() moji = "d:\*.*" tmp = Dir(moji, vbNormal) Do While tmp <> "" GAvalue = GetAttr("d:\" & tmp) Debug.Print tmp, GAvalue tmp = Dir() Loop End Sub Dir関数ではファイルを持ってきてくれるのですがどうしてGetAttr関数の返り値はvbArchive=32になってしまうのか教えてください以上よろしくお願い致します

質問日時: 2022/12/22 15:25 質問者: 公共ごま

ベストアンサー

2

0
EXCEL VBAで教えてください。

EXCEL　VBAで教えてください。 A列の７桁の数字の一番左の数字をアルファベットに変換したい。１の場合はA、２の場合はB、３の場合はC… （例）1314567→A314567 　　　2567568→B567568 とりあえず以下の方法で出来ました。 ①A列の一番左の数字をLEFTでB列に表示し、select case でアルファベットに置換 ②A列の数字の左から２番目から７番目までをC列に表示（MID） ③D列にB列とC列を＆でつなげる（do untilを使用）もっと簡単に高速に処理できる方法を教えてください。（A列は1万行ぐらいあります）

質問日時: 2022/12/22 04:20 質問者: tommygoo1

ベストアンサー

1

0
Changeイベントで複数セルへの貼り付けおよび値削除時に1個目のセルのみエラーになる

下記はAシートのコードで、C列をTargetとしています。C列に社員番号を入力し、Enterを押すと社員名に切り替わって表示され、存在しない番号の入力や直接入力（社員名を直接入力する人もいるため）でもエラーが出ないよう「On Error Resume Next」を追加しております。 Bシートに社員情報が記載されており、BシートのA列が社員番号、C列に社員名の一覧があります。下記のコードの状態で、AシートのC列の複数行に貼り付け、もしくは複数行の値を一気に削除（Deleteを押す）すると、両者とも１個目のセルのみがN/Aとなってしまいます。１個目のセルにも問題なく張り付け、および削除が成功するコードを教えて頂けますでしょうか。＜現在のAシートのコード＞ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column = 3 Then With Cells(Target.Row, Target.Column) .Value = WorksheetFunction.VLookup(Target.Cells, Worksheets("B").Range("A2:B5001"), 2, False) End With End If On Error GoTo 0 End Sub

質問日時: 2022/12/21 09:07 質問者: 7ujm

ベストアンサー

3

0
EXCEL関数LOOKUPとFILTERについての質問です

SHEET1に4項目（バーコード、商品番号、商品名、仕入れ価格）の商品が複数あります。これは入荷伝票です。 SHEET2には５項目（バーコード、商品番号、商品名、仕入れ価格、売価）の商品があります。これは在庫伝票です。入荷伝票の仕入れ価格のあとにVLOOKUPを使い、SHEET2のバーコードと同じバーコードの商品の売価を表示させています。新商品はSHEET2には登録されていないので、N/Aの表示になります。新しくSHEET３を作り、SHEET1でN/A表示になった商品だけのリストを作るにはFILTER関数を使うのでしょうか？　その場合のテクニックを教えて下さい。お願いします。

質問日時: 2022/12/21 05:53 質問者: 人生カウンセラー

ベストアンサー

1

0
九九の答えの計算

VBで掛け算の九九のn段からm段までの答えの合計を表示するプログラムを作りなさい。なお、n<mとする。という問題があるのですがよくわかりません。 Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged Dim i, b, s As Integer s = 0 For i = 1 To 9 For d = 1 To 9 s = i + b Next Next TextBox3.Text = s End Sub End Class 自分なりにここまでやったのですがTextbox2の段のやり方などよく分からないです。vb初心者なので誰か教えてくださる方いませんか？

質問日時: 2022/12/20 22:13 質問者: むぎちょこ0456

解決済

3

0
ワークブック内すべて検索

いつもお世話になっております下記のコードは　シート内にある　Ａ　検索して一つ一つ選択されます。ただ下記のコードを削除すると MsgBox i & "個目に見つかった場所です" 最後に見つかったセルのみ選択されます。コマンドボタンを押すたびに選択することは可能でしょうかできれば、ワークブック内すべて Sub try() Dim r As Range Dim st As String Dim i As Long Set r = Cells.Find(What:="A", LookIn:=xlValues, LookAt:= _ xlPart) If r Is Nothing Then Exit Sub st = r.Address Do i = i + 1 r.Select MsgBox i & "個目に見つかった場所です" Set r = Cells.FindNext(ActiveCell) Loop Until st = r.Address MsgBox "全部検索したので終わります" Set r = Nothing End Sub

質問日時: 2022/12/20 20:13 質問者: りんごプリン

解決済

2

1
セルの変更で処理するマクロについて

マクロでB列のセルを不要に変更したらその【不要】にした行を削除するマクロを作成したいのですが削除が出来ても後にエラーが出てしまいます。マクロを教えてほしいです。

質問日時: 2022/12/20 18:09 質問者: nnmewg

解決済

1

1
ワークシート内を検索

いつもお世話になっております下記のコードは以前教え頂きましたコードです。これをワークシート内を検索するにはどうしたよろしいでしょうかわかる方おしえてくれませんでしょうか Private Sub CommandButton1_Click() 　　Dim lastrow As Long 　　Dim actrow As Long, actcol As Long 　　Dim i As Long 　　actcol = Selection.Column 　　actrow = Selection.Row 　　lastrow = Cells(Rows.Count, actcol).End(xlUp).Row 　　For i = actrow + 1 To lastrow 　　　　If Cells(i, actcol) Like "*" & TextBox1 & "*" Then 　　　　　　Cells(i, actcol).Select 　　　　　　Exit For 　　　　End If 　　Next End Sub

質問日時: 2022/12/19 23:46 質問者: りんごプリン

ベストアンサー

1

1
VBAについて教えてください

VBA初心者なので説明不足な点等あると思いますがご容赦ください。ユーザーフォームにチェックボックスをいくつかつくりチェックを入れたらアクティブセルに繋げて入力できるようにしたいです。どうすればいいか教えてください。ユーザーフォーム ☑︎りんご ◻︎れもん ☑︎ばななアクティブセルりんごばななのような感じです。

質問日時: 2022/12/18 11:02 質問者: さな99

ベストアンサー

4

2
いつもお世話になります下記のコード実行するとエラーになりますわかるかた教えてくれませんでしょう

いつもお世話になります下記のコード実行するとエラーになりますわかるかた教えてくれませんでしょうか Select Case True Case Left(Range("A1:A10").Value, 1) = "A" Range("A1").Offset(, 1).Value = "A" Case Left(Range("A1:A10").Value, 1) = "B" Range("A1").Offset(, 1).Value = "B" Case Mid(Range("A1:A10").Value, 3, 1) = "C" Range("A1").Offset(, 1).Value = "C" End Select 宜しくお願い致します

質問日時: 2022/12/17 15:01 質問者: 東西線

ベストアンサー

6

0
FileSearch2007に変わる構文について

前回の質問と並行しています。このFileSearch2007では、今のエクセル形式.xlsm に対応していません。純粋に今の形式に対応可能な構文の記述が全く分かりません。何かヒントなどをご教授いただければ幸いです。よろしくお願いいたします。 Function FileSearch2007(dir_path, target_extention) Set found_files = New Collection Call FileSearch2007_Repeat(dir_path, found_files, target_extention) Set FileSearch2007 = found_files End Function Private Sub FileSearch2007_Repeat(dir_path, found_files, target_extention) Set fso = New FileSystemObject Set target_folder = fso.GetFolder(dir_path) For Each sub_folder In target_folder.SubFolders Call FileSearch2007_Repeat(sub_folder.Path, found_files, target_extention) Next sub_folder For Each objFile In target_folder.Files With objFile If ((UCase(fso.GetExtensionName(.Path))) = target_extention) Then found_files.Add Item:=.Path End If End With Next objFile Set fso = Nothing End Sub

質問日時: 2022/12/16 16:57 質問者: VBA_muzukashii

ベストアンサー

1

1
ExcelVBA ドロップボックスで月を選択するとそれ以降のデータが残るようにしたい。

ExcelVBAについて2点質問です。画像のようにコンボボックスのリストを変更すると、 C列にフィルターがかかる仕様です。 ①シートには保護がかかっており、マクロ実行の際に ActiveSheet.Protect UserInterfaceOnly:=True で保護した状態でも実行できるようにしているのですが、シートの保護を解除してから実行してくださいというエラーがでます。他のマクロもあり、他ではシートの保護に関するエラーが出ずに実行されるのですがどうして実行されないのでしょうか。 ※シートの保護を解除すると思った結果になります。ボタンでの実行ではなく、コンボボックスの値が変更されると実行されるマクロでは ActiveSheet.Protect UserInterfaceOnly:=True が効かないなどあるのでしょうか。 ②また現在はコンボボックスの値の月のみフィルターで表示されるようになっていますが、コンボボックスで指定した月以降がすべて表示されるようにするにはどうしたらよいでしょうか。 ▼現在のコード Sub ドロップ1_Change() ActiveSheet.Protect UserInterfaceOnly:=True With Worksheets("sheet1").Range("A2").CurrentRegion .AutoFilter .AutoFilter 3, Worksheets("sheet1").Range("H3") Cancel = True End With End Sub

質問日時: 2022/12/16 14:53 質問者: jabcksjergt

ベストアンサー

3

0
エクセル２つの列にある値の完全一致を抜き出すVBA

お世話になります。エクセルでデータを貼り付けしたときに、 A列とB列の完全一致データを行ごと（AからMまで）別のシートに摘出したいと思っております。また一致したデータは削除せずに全て摘出したいと考えております。膨大なデータ数ですので処理に時間はかかると思っておりますが、 VBAで自動で処理できる方法をご教示頂けないでしょうか。ご指導を宜しくお願いいたします。

質問日時: 2022/12/15 03:22 質問者: gousann72

ベストアンサー

15

1
VBA コードの意味を教えて下さい。

基本的なことですみません。参考コードを読んでいたが、Cells（a-4,2)というコードが出てきました。sellの位置がわかりません。教えて下さい。

質問日時: 2022/12/14 18:34 質問者: sanshaintosi

ベストアンサー

3

0
検索

いつもお世話になっておりますおしえてくれませんでしょうかユーザーフォームにテキストボックスとコマンドボタンが設置されています。テキストボックスに　例）田　と入力したら、　田を含んでいるＢ列を一つ一つの　選択していくことは可能でしょうかわかる方おしえてくれませんでしょうか

質問日時: 2022/12/14 18:21 質問者: りんごプリン

ベストアンサー

3

1
Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています

Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています。しかしセルごとにカウント数を転記すると44個のセルがあり、同じようなマクロが必要になるため、D表の行と列を参照してループできるようなマクロを勉強したいのですが教えてください。 Sub D表19() Worksheets("状況").Activate Call Z_AutoFilterOff Dim Count As Long With Range("B4") 　　　　.AutoFilter 2, "A" '抽出分類　　　　.AutoFilter 4,Criteria1:="<=19" '抽出年齢 End With Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1)) Worksheets("D表").Activate Range("C5").Value = Count - 1 End Sub

質問日時: 2022/12/14 17:57 質問者: momo_2123

ベストアンサー

7

0
VBA初心者です。電話番号の数字の前に0を表示させたいです。

教えて下さい。 VBA初心者です。 CSVファイルから電話番号のセルをコピーしてエクセルに貼り付けました。 CSVファイルにも頭の0の表示がない状態です。番号の最初に0をつけるにはどのように表記すればいいでしょうか。電話番号は固定電話（0をつけて10桁にしたい）と携帯電話（0をつけて11桁にしたい）があります。 CSVファイル名・・・しーえすぶい.csv （電話番号が入っている）A1セルをコピー　➡　例　123456789 エクセルファイル名・・・エクセル.xlsm B1セルに貼り付け Windows("しーえすぶい.csv").Activate Range("A1").Select Selection.Copy Windows("エクセル.xlsm").Activate Range("B1").NumberFormatLocal = "@"

質問日時: 2022/12/14 03:58 質問者: マーフィーマーフィー

解決済

2

1
Excel VBAのデバッグ

私はExcel2016を使用していますが、Excelファイルを開けると写真のようなデバックが出るのです。同じファイルをExcel2013を使用している方が開けると出ないで使用できるのですがどうしてでしょうか？どうやれば私のほうでデバックがでないで使用できるか教えて頂けませんか？よろしくお願いします。【デバック箇所】 Private Sub Workbook_Open() Dim i As Long For i = 1 To Sheets.Count ⇒ この部分が黄色くなってます。Sheets(i).Protect Password:="0630", UserInterfaceOnly:=True Next i End Sub

質問日時: 2022/12/13 16:08 質問者: tttaaa7

解決済

8

0
Wordマクロで指定したフォルダ名に保存する方法について

保存されているWordのフォルダ名：”A”の階層化に、"01．出力先"というフォルダを作成しました。フォルダ名：”A”に保存されているWordを立ち上げ、マクロ実行後、"01．出力先"フォルダにファイルを格納したいのですが、以下マクロで ”ファイル名 = myParentFolderPath & "\01.出力先\" & "ファイル名" & ".docx"” がエラーになってしまいます。どのようにマクロを書けば良いのか？教えてください。 --------------------------マクロ-------------------------------------------------- Sub ファイル出力() ' ' ファイル出力 Macro With ActiveDocument.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord End With .Execute Pause:=False End With Dim ファイル名 As String ファイル名 = ActiveDocument.Paragraphs(1).Range.Text ファイル名 = Left(ファイル名, Len(ファイル名) - 1) & ".docx" ActiveDocument.SaveAs _ ファイル名 = myParentFolderPath & "\01.出力先\" & "ファイル名" & ".docx", FileFormat:= _ 　　wdFormatXMLDocument, Password:="ddddd1001" End Sub

質問日時: 2022/12/13 11:35 質問者: はらちゃんgo

ベストアンサー

8

0
excel vba でユーザーフォーム入力ができない

お世話になります。ボタンをクリックするとユーザーフォームが立ち上がり、パスワードを入力後非表示シートを表示させて、データが入力する。とものを作成しましたがシートを入力し保存後、ユーザーフォームを立ち上げるとパスワードが入力できない状態です。カーソルはテキストボックスに入りますが文字が打てません。ユーザーフォームを立ち上げる前に保存をしなければ問題ないのですが・・・このような事は不可解でわからません。ご教授をお願い致します。 Private Sub CommandButton1_Click() UserForm1.Show vbModeless UserForm1.TextBox1.SetFocus End Sub

質問日時: 2022/12/12 14:42 質問者: khre21

解決済

2

0
ListBox1をClickしたときのイベント

いつもお世話になっております下記のコードは ListBox1をClickしたときに ListBox2に担当のお客様が表示されるというものです。ここでListBox1をマルチセレクトしたときに ListBox2に表示させることは可能でしょうか添付ファイルを２回に分けます。わかる方おしえてくれませんでしょうか無理なのでしょうか。よろしくお願いいたします。 Private Sub ListBox1_Click() Dim dic As Object Set dic = CreateObject("Scripting.dictionary") ListBox2.Clear For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(i, "H").Value = ListBox1.List(ListBox1.ListIndex) Then If Not dic.Exists(Cells(i, "H").Value) Then With ListBox2 .AddItem "" .List(.ListCount - 1, 0) = Cells(i, 3).Value End With End If End If Next Set dic = Nothing End Sub Private Sub UserForm_initialize() With ListBox1 .AddItem "近藤" .AddItem "工藤" .AddItem "遠藤" .AddItem "加藤" End With End Sub

質問日時: 2022/12/11 19:45 質問者: りんごプリン

ベストアンサー

5

2
Sheet1をフィルターで「りんご」を抽出し、Sheet2へ地域を貼り付ける下記マクロを変更して S

Sheet1をフィルターで「りんご」を抽出し、Sheet2へ地域を貼り付ける下記マクロを変更して Sheet2のB列で青森が２行あれば、C列へ「2」、B列で長野が1行あればC列へ「1」と行をカウントした数値を入れたいのですができません。教えてください。 Sub test1() Dim ws1 As Worksheet, ws2 As Worksheet Dim LastCell As Long Set ws1 = Worksheets(1) Set ws2 = Worksheets(2) LastCell = ws1.Cells(Rows.Count, 2).End(xlUp).Row With ws1.Range("B4") .AutoFilter 1, "りんご" .Offset(1, 3).Resize(LastCell - 4).Copy ws2.Range("B3") 　　　　.AutoFilter End With End Sub

質問日時: 2022/12/11 03:01 質問者: momo_2123

ベストアンサー

2

1
ワークブックを追加したあとにシート名を変更することは可能でしょうか

いつも大変お世話になっております。下記のコードでワークブックを追加したあとに　シート名を変更することは可能でしょうか set targetR =thisworkbook.worksheets("a").range("A1").currentregion set wb =workbooks.add targetR.copy wb.worksheets(1).range("A1")　'ここの部分です。 wb.close

質問日時: 2022/12/10 22:44 質問者: りんごプリン

ベストアンサー

1

1
vba 最大値条件分岐

こんにちは。 VBAの最大値の求め方の質問です。期待利益3、4.5、3.5の順番で範囲cells(30~32,''G'')の中から最大値を求めなくてはいけなくて、求めた最大値をcells(33,''G'')に入れたいです。 Dim maxx as integer,x as integer maxx = 0 For x = 1 To 3 If maxx < Cells(30, "G") Then 'これが3.0 maxx = Cells(30, "G") ElseIf maxx < Cells(31, "G") Then 'これが4.5 maxx = Cells(31, "G") Else　　'これが3.5 maxx = Cells(32, "G") End If Cells(33, "G") = maxx Next x 最初にある maxx = 0 For x = 1 To 3 If maxx < Cells(30, "G") Then maxx = Cells(30, "G") この部分で既にmaxxが0より大きいのでelseif以降が機能しないのは分かっています。どう書き直せば3つの数字の中から比較できるか知りたいです。よろしくお願いします。

質問日時: 2022/12/10 10:20 質問者: apupoops

解決済

4

0
複数条件のオートフィルタ（VBA）

excel vbaについて質問です。画像のようにAからGまでデータが入力されており、以下の2つでオートフィルターをしたいです。 textbox1→A列 combobox1→G列以下では①のあと②が実行されてしまい、同時にフィルターをかけることができません。 ※V1にはcomboboxのリストに値が入っています。 ①With Worksheets("sheet1").Range("A2").CurrentRegion .AutoFilter .AutoFilter 1, Worksheets("sheet1").TextBox1.Text End With ②With Worksheets("sheet1").Range("A2").CurrentRegion .AutoFilter .AutoFilter 7, Worksheets("sheet1").Range("V1").Text Cancel = True End With よろしくお願いします。

質問日時: 2022/12/09 15:40 質問者: jabcksjergt

ベストアンサー

2

0
[Excel VBA] このコードでは行の挿入や行の消去をすると13のエラーが出てしまう。

下記のコードでは、行の挿入や行の消去をすると13のエラーが出てしまいます。デバックでは、 If Val(Target.Value) = Val(Range("E" & Target.Row).Value) Then を示しているのですが、直し方が分かりません。。。教えていただけましたら幸いです。毎度、エラー時に「終了」を押して作業しています。 Windows10/Excel2019 で使用中です。 --------------------------- Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1:A245")) Is Nothing = False Then If Val(Target.Value) = Val(Range("E" & Target.Row).Value) Then Application.EnableEvents = False Target.Value = "'" & Target.Value Application.EnableEvents = True Else MsgBox "番号が違います" Application.EnableEvents = False Target.Value = "再入力" Application.EnableEvents = True End If ElseIf Intersect(Target, Range("B1:B245")) Is Nothing = False Then If Target.Value = "1" Then Application.EnableEvents = False Target.Value = "済" Application.EnableEvents = True ElseIf Target.Value = "2" Then Application.EnableEvents = False Target.Value = "未確認" Application.EnableEvents = True End If End If End Sub ---------------------------- 宜しくお願いいたします。

質問日時: 2022/12/09 00:29 質問者: こんにちはneza

解決済

3

0
ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています

古いプログラムで10年以上使っています。一番下のフォルダには、以前古いエクセルファイル Excel 97-2003 ワークシート (.xls) が入っていました。（簡単なマクロも入っています）そのファイル群の合計データの一部を項目別に入荷集計表に反映するプログラムです。マイクロソフトで古いエクセルファイルのサポートが終わっていましたので、ファイル全てを .xlsm に変更したところ、プログラムが途中で落ちてしまっています。対応方法をご教授いただけると大変助かります。 FileSearch2007が使えなくなったことも原因かなと思うのですが、どうしてもわからなく困っています。新しいファイル検索のプログラムがあるようなのですが、初心者のため、理解が難しく非常に困難な状況に置かれています。最新のエクセルで動作するようプログラムを教えていただけるでしょうか。現在のプログラムは下記にあります。 "C:\Users\ユーザーアカウント名\Desktop\在庫表\受払.xlsm" このプログラムを使って、 C:\Users\ユーザーアカウント名\Desktop\在庫表\在庫表詳細\顧客にある*.xlsm"ファイルを検索して別の集計表に反映するプログラムです。どうか、よろしくお願いいたします。－－－－－－－以下プログラム－－－－－－－ Dim FAR(1999), AR(1999, 9), ゼロ表示, 件数, 最終行 Dim wkDate As Date Sub P11_フォルダ内容書出し() 記入済データを消去_11 進度表示_11 パス名Book名を配列ARに格納_11 個別Bookの内容を配列に格納_11 配列の内容をシートに記入_11 並び替え_11 End Sub '*---------------------------------------------------------------------------------* Function 記入済データを消去_11() Worksheets("入荷集計表").Activate Application.DisplayAlerts = False Application.ScreenUpdating = False Msg = "シート「入荷集計表」を最新の状態に更新します。実行しますか？" msg_rt = MsgBox(Msg, vbYesNo) If msg_rt <> vbYes Then End If Range("B4") <> "" Then Rows("4:" & 1999).Delete Shift:=xlUp End If If IsDate(Range("G2")) Then wkDate = CDate(Range("G2")) Else wkDate = CDate("2060/12/31") End If Debug.Print Format(wkDate, "yyyy/mm/dd") End Function '*---------------------------------------------------------------------------------* Function パス名Book名を配列ARに格納_11() k = -1 target_path = ThisWorkbook.Path target_extention = UCase("xlsm") Set found_file = FileSearch2007(target_path, target_extention) 件数 = found_file.Count If 件数 = 0 Then MsgBox "*.xlsmファイルがないため処理を終了します。" End End If For i = 1 To 件数 If Right(found_file(i), 10) <> "フォーマット.xlsm" And _ Right(found_file(i), 7) <> "在庫表.xlsm" Then k = k + 1 FAR(k) = found_file(i) End If Next End Function '*---------------------------------------------------------------------------------* Function 個別Bookの内容を配列に格納_11() '合計の行をFIND関数で検索する　　Do～Loopは時間がかかるため Dim Idx1 As Integer k = -1 For i = 0 To 1999 If FAR(i) = "" Then Exit For Workbooks.Open Filename:=FAR(i), UpdateLinks:=0 '外部リンクを表示しない For Idx1 = 7 To 1000 If Range("C" & Idx1) = "" Then Exit For End If k = k + 1 AR(k, 0) = FAR(i) AR(k, 1) = Range("E1") AR(k, 2) = Range("M2") AR(k, 3) = Range("C2") AR(k, 4) = Range("H2") AR(k, 5) = Range("C3") AR(k, 6) = Range("B" & Idx1) AR(k, 7) = "'" & Range("C" & Idx1) AR(k, 8) = Format(Range("Z" & Idx1), "0.0") AR(k, 9) = "'" & Range("AF" & Idx1) Next Idx1 件数 = k ActiveWorkbook.Close Next i End Function '*---------------------------------------------------------------------------------* Function 配列の内容をシートに記入_11() Workbooks("RCM受払.xlsm").Worksheets("入荷集計表").Activate 行 = 3 For i = 0 To 件数 If AR(i, 0) <> "" Then If AR(i, 8) <> 0 And AR(i, 6) <= wkDate Then 行 = 行 + 1 For j = 1 To 9 'B列:P列 Cells(行, j) = AR(i, j) Next Cells(行, 10) = AR(i, 0) End If End If Next 最終行 = 行 End Function '----------------------------------------------------------------------------------------*

質問日時: 2022/12/07 12:03 質問者: VBA_muzukashii

ベストアンサー

17

3
セルS2に入力した「月」と一致したB列の右隣へセルS110の値を転記する下記マクロを実行するとエラー

セルS2に入力した「月」と一致したB列の右隣へセルS110の値を転記する下記マクロを実行するとエラー(RangeクラスのPastメソッドが失敗しました。)となります。解決策を教えてください。 Sub test1() Dim c As Long '処理月S2へS5を転記 For c = 112 To 123 If Cells(c, 2).Value = Range("S2").Value Then Exit For Next c If c < 15 Then Range("S110").Copy Cells(c, 3).PasteSpecial Paste:=xlPasteValues End Sub

質問日時: 2022/12/06 17:32 質問者: momo_2123

ベストアンサー

2

0
最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされて

最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされてしまいます。最終列＋１をどの段階で記入したらよいか教えてください。 Sub　test1() Dim ColE, lrow As Long Dim LCol, XCol, NCol As String ColE = Cells(2, Columns.Count).End(xlToLeft).Column '2行目の最終列を取得 LCol = Cells(3, ColE).Address '3行目の最終列のセル番号を取得（"I3"） XCol = Cells(3, ColE - 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) 'SUM関数で使う最終列-1のセル番号を取得（"H3"） lrow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を取得 With Range(LCol) .Formula = "=SUM(C3:" & XCol & ")" '最終行にSUM関数「C3～最終列」を代入 .AutoFill Destination:=.Resize(10, 1) 'AutoFillを使い横列分複写する End With NCol = Cells(2, ColE).Address '2行目の最終行のセル番号を取得 With Range(NCol) .Formula = "合　計" 'I列先頭行に”合計”を代入 .HorizontalAlignment = xlCenter 'I列の先頭行合計”を中央揃え End With End Sub

質問日時: 2022/12/05 20:32 質問者: momo_2123

ベストアンサー

3

0
改ページを挿入

いつもお世話になっております下記のコードは改ページを挿入するコードなのですが、 w.PageSetup.PrintArea = Range("B3", Cells(Rows.Count, "B").End(xlUp)) でエラーになります。わかる方おしえてくれませんでしょうか Dim w As Worksheet Set w = ActiveSheet w.PageSetup.PrintArea = Range("B3", Cells(Rows.Count, "B").End(xlUp)) w.ResetAllPageBreaks w.HPageBreaks.Add Range("A13") w.VPageBreaks.Add Range("G:G")

質問日時: 2022/12/04 23:19 質問者: りんごプリン

ベストアンサー

1

1
日付を重複させずに数えたい

sheet1に日計のデータがあり、sheet2に集計（日数や距離など）したいです。（添付画像を参照して下さい）この際、担当者ごとに出勤日数を数えたいのですが、同一人で同じ日のデータが複数あるので、重複させずに日数を数えたいです。下記のような感じで組んでいるのですが、日数合計の出し方がわかりません。 Dim i As Long, n As Long, d As Long Dim km As Long Dim lrow As Long Dim name As String Sub total() lrow = Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To lrow name = Worksheets("sheet1").Cells(i, 12).Value '該当データの担当者名 n = Worksheets("sheet2").Range("B3:B11").Find(what:=name, lookat:=xlWhole).Row 'sheet2の担当者行番号 d = Worksheets("sheet1").Cells(i, 2).Value '該当データの日付 km = Worksheets("sheet1").Cells(i, 11).Value '該当データの距離 '＜ここに、sheet2への集計方法を記載したい＞ '＜特に、担当の”日数”を数える方法がわからない＞ Worksheets("sheet2").Cells(n, 4).Value = Worksheets("sheet2").Cells(n, 4).Value + km '＜距離の加算はこんな感じで良いと思います＞ Next i End Sub

質問日時: 2022/12/04 16:26 質問者: 88suihou88

ベストアンサー

4

0

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

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

質問する（無料）

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

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

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

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

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

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