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

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

回答数

気になる

ExcelのVBAコードについて教えてください。

シート名：受付のVBAコードを設定しております。シート内のセルを変更するたびにシート全体が更新？されるようで、セルに対してのマクロを実行した場合でも、かなりの時間がかかります。解決方法があれば教えてください。コード Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As Variant Dim i As Integer tbl = Array("D10", "D11", "E10", "E11", "F10", "F11") With Worksheets("審査") For i = 0 To 5 .Range("B" & 26 + i).Value = Range(tbl(i)).Value If Range(tbl(i)).Value = "" Then .Range("E" & 26 + i).Value = "" Else .Range("E" & 26 + i).Value = "後日図書の提出をお願いいたします。" End If Next i End With Application.ScreenUpdating = False Application.EnableEvents = False On Error Resume Next Sheets("消防添").Visible = [R37] = "消防添" Sheets("F審査").Visible = [F14] = "ﾌﾗｯﾄ35(設計)" Application.ScreenUpdating = True Application.EnableEvents = True If Range("D2").Value = "紙申請" Then Call 電図 Else Call 紙図 End If If Range("N41").Value = "■" Then Call 注意1表示 End If If Range("F3").Value = "札幌市" Then Call 注意2表示 End If If Range("D7").Value = "計画変更" Then Call 注意3表示 End If If Range("N44").Value = "■" Then Call 注意4表示 End If If Range("N45").Value = "■" Then Call 注意5表示 End If If Range("D7").Value = "計画変更" Then Call 注意6表示 End If If Range("D7").Value = "計画変更" Then Call 注意7表示 End If If Range("N46").Value = "■" Then Call 棟数表示 End If If Range("L67").Value = "■" Then Call 印刷表示 End If If Range("G205").Value = "■" Then Call 構造 End If If Range("R66").Value = "■" Then Call 車庫増築 End If If Range("D5").Value = "車庫等：単独" Then Call 車庫単独 End If If Range("R55").Value = "車庫注意" Then Call 車庫単独 End If If Range("W85").Value = "F電子" Then Call フラット紙非 End If If Range("W86").Value = "F紙" Then Call フラット電非表示 End If If Range("W85").Value = "F電子" Then Call 電子フラット保存 End If If Range("W86").Value = "F紙" Then Call 紙F保存 End If If Range("D7").Value = "計画変更" Then Call 計変画像表示 End If If Range("F8").Value >= 3 Then Call 通路 End If End Sub よろしくお願いします。

質問日時: 2023/05/26 10:43 質問者: エクセル小僧

ベストアンサー

4

0
VBAでPDFのアクティブページ番号取得

※Adobe Acrobatは持っていません。請求書、納品書、受領書などが１つのPDFの中に複数件入っていて数百ページに及びます。 Excel VBAから該当PDFを開き、sendkeys ctrl+f で"請求書"を検索してそのページを印刷したいのですが、アクティブページ番号の取得は可能でしょうか。総ページ数の取得はネット検索でいろいろ出てきますが、アクティブページ番号の取得は見つかりません。どうぞ宜しくお願いします。

質問日時: 2023/05/25 12:41 質問者: tomoneel

ベストアンサー

1

0
VBA Userformで一部別シートに転記がしたいのですが

VBAド素人でネット参考に切って貼って編集して動くようにしていますm(__)m うまくいきません、どのようにしたらよいのでしょうか？ Userformを開いて作業するシートはこのフォームで管理番号と使用者の該当する行を削除します使用者（ComboBox1）条件抽出の為管理番号（ComboBox6）条件抽出の為メモ（ComboBox７）転記先シート”機器情報” メモには在庫または使用を入力し別シートの管理番号行の転記する列はM列になりますわかる方からしたら酷いコードでしょうけどこんな感じです Private Sub CommandButton1_Click() Dim I As Integer Dim iCheck As Integer Dim sht As Worksheet Dim RowNum As Long Dim a If Me.TextBox1 = "" Then MsgBox "日付が入力されてません" Exit Sub End If If Me.ComboBox1 = "" Then MsgBox "使用者名が入力されてません" Exit Sub End If For I = 2 To 1000 If Cells(I, 3).Value = "" Then Exit For Next '重複チェック iCheck = I For iCheck = 1 To I 'メモ/在庫変更 If Worksheets("機器情報").Cells(iCheck, 2) = ComboBox6 Then Worksheets("機器情報").Cells(I, 13).Value = ComboBox7 Exit Sub End If If Cells(iCheck, 3).Value = Me.ComboBox6.text Then MsgBox "PC名が重複してます" Cells(iCheck, 3).Select Exit Sub End If Next '連番 Cells(I, 1).Value = I - 2 '編集日 Cells(I, 2).Value = CDate(TextBox1.Value) 'PC名 Cells(I, 3).Value = Me.ComboBox6 '使用者名 Cells(I, 15).Value = Me.ComboBox1 Cells(iCheck, 3).Select Me.ComboBox6.SetFocus Me.ComboBox6.text = "" Me.ComboBox1.text = "" Exit Sub End Sub '機器リスト表示 Private Sub UserForm_Initialize() Dim lRow As Long With Worksheets("機器在庫数") lRow = .Range("M" & Rows.Count).End(xlUp).Row End With With ComboBox6 .ColumnCount = 12 .ColumnWidths = "\55;0;60;0;0;0;0;70;0;0;0;30" .RowSource = "機器在庫数!A2:M1000" & lRow End With End Sub

質問日時: 2023/05/24 13:08 質問者: ka-.-ji

解決済

2

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

シートコピーのマクロを実行した後で、コピー先のファイルを削除する方法を教えてください。マクロ Sub シートコピー一般() 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\確認部\■意匠\戸建\戸建て電子申請関連\ひな形\フラット関係\他の帳票（設計検査調書）\" srcFileName = "*.xlsx" ' コピー先の作業ブックとシートを指定 Set destWorkbook = ThisWorkbook Set destSheet = destWorkbook.Sheets("マクロシート") ' コピー元のファイルを検索 srcFileName = Dir(srcFolderPath & srcFileName) ' コピー元のブックを開く Set srcWorkbook = Workbooks.Open(srcFolderPath & srcFileName) ' コピー元のシートを取得（一番左のシート） Set srcSheet = srcWorkbook.Sheets(1) ' コピー元のシート名を取得 srcSheetName = srcSheet.Name ' コピー元のシートをコピー先にコピー srcSheet.Copy After:=destSheet ' コピー元のブックを閉じる srcWorkbook.Close SaveChanges:=False End Sub このマクロを実行すると指定フォルダ内の指定ファイル「 "*.xlsx"」のシートが作業ブックのシートにコピーされます。このマクロに追加して作業ブックにシートがコピーされた後に、指定フォルダ内の指定ファイル「"*.xlsx"」を削除する方法を教えてください。指定フォルダ内には最新のファイルのみを保存して、作業をしている為、作業ブックにシートがコピーされれば、コピー先のファイルは不要となりますので、詳しい方、よろしくお願いします。

質問日時: 2023/05/24 08:33 質問者: エクセル小僧

ベストアンサー

4

0
VBAで特定の場所にあるCSVファイル（複数）から特定場所を抜き出してExcelに転記したいです。

VBAで特定の場所にあるCSVファイル（複数）から特定場所を抜き出してExcelに転記したいです。画像①②がCSVファイルの中身になります。（①と②は同じファイルで③の転記のイメージの為分けてます）画像③が転記後のExcelファイルのイメージになります。 ①と②の色の部分が③転記のイメージになります。 1.CSVファイル（①のイメージ）からD8〜E32までを抜き出してExcelファイル（③）B3〜C27に転記。二つ目のファイルはDに。次はF.H.Jと転記していく。それに合わせて③の黄色部分（B1.D1.F1・・・）に抜き取ったファイル名を記載。ファイルは昇順で取得していく。 2.CSVファイル（②のイメージ）からE13〜E16、E21〜E24、E29〜E32を1.で転記した最後の行から一行空けて転記。 D9〜D12、D17〜D20、D25〜28はその次の行に転記。 3.はできるなら 1で出力した結果からExcelファイルの赤と橙の所に記載する方法も知りたいです。（③のイメージ） 1はファイル毎に転記。 2は一列にまとめて転記。 2は何となく出来たのですが1のやり方が分からずご教示いただきたく。よろしくお願いいたします。

質問日時: 2023/05/23 16:29 質問者: 。ゆき

ベストアンサー

11

0
ExcelのVBAコードについて教えてください。

作業ブックのThisWorkbookに下記のコードを設定しております。 Private Sub Workbook_Open() Dim tmp, dNow tmp = Split(ThisWorkbook.Name, ".") If Split(ThisWorkbook.Name, ".")(UBound(tmp)) <> "xlsm" Then dNow = Format(Now, "yyyy/mm/dd") With Worksheets("300") If dNow >= Format(.Range("D39"), "yyyy/mm/dd") _ And dNow <= Format(.Range("E39"), "yyyy/mm/dd") Then If MsgBox("便利帳・条例の比較（差分）の確認を行ってください。" & Chr(13) & "確認済の場合は「いいえ（N）をクリック」続けますか。", vbYesNo + vbExclamation) = vbYes Then '「はい」のときに実行される処理 Call 比較日付 Call 便利帳比較ひな形 Call シート300確認 '「いいえ」のときに実行される処理 End If Exit Sub End If End With End If End Sub このコードは、マクロ有効テンプレート方式「.xltm」の時のみにシート名「300」のセルに設定している日付がブックを開いた日付の範囲内であればメッセージBOXが表示されます。このコードに追加してファイル名が「【フラット】○○.xlsm」（マクロ有効形式）だけを開いたタイミングでシート名「F審査」のセル値「E15」をセレクト出来る方法を教えてください。 Sheets("F審査").Select Range("E15").Select ファイル名の「【フラット】○○.xlsm」（○○）部分は物件によって変更されますが先頭の「【フラット】」は固定です。よろしくお願いします

質問日時: 2023/05/23 16:28 質問者: エクセル小僧

ベストアンサー

2

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

マクロ Sub 保存() Application.ScreenUpdating = False Dim wb As Workbook Set wb = ThisWorkbook wb.Worksheets("一戸建て等（機構承認住宅用）").Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=wb.Path & "\" & ActiveSheet.Range("B7").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.Close False Application.DisplayAlerts = True Application.Quit wb.Close False End Sub があります。このマクロを実行すると指定セル値に表示される文字をファイル名として「.xlsx」方式で保存されます。このマクロを実行しファイルが保存されたタイミングでマクロがある、作業ブックを削除できる方法を教えてください。（警告文のダイナログ無し）ファイル名が保存された後は作業ブックは必要無くなりますので。よろしくお願いします。

質問日時: 2023/05/23 15:54 質問者: エクセル小僧

ベストアンサー

1

0
VBA 別sheetからの転記なのですが

他のBOXはこのsheetに転記なのですがComboBox6（管理番号）は参照している別sheetですその管理番号の行にあるM列にComboBox7の入力したコメントを転記したいのですがどのようなコードにしたらよいのでしょうか？入力しなかったら別sheet記載のままで入力がある時のみ上書きができるようにしたいです

質問日時: 2023/05/22 15:55 質問者: ka-.-ji

解決済

2

0
特定の文字を含むシートだけマクロ処理をしたい

フォルダに入っている複数のブックを別ブックに転記するという処理をしたいのですが、シートが複数ありまたシート名が毎回異なる為、ある特定の文字を含んだシート名が入っていた場合処理を適用する、ということをしたいです。しかしFor ～　の構文を使ってもうまくいきません。。。どなたか下記★部分のマクロのコードを教えていただけないでしょうか。 Dim fpath As String, fname As String Dim wb As Workbook Dim sh As Worksheet Dim no As Variant Dim no2 As Variant Application.ScreenUpdating = False With Worksheets("メニュー") fpath = .Range("コピー元フォルダ指定パス").Value & "\" Set sh = Worksheets(.Range("コピー先指定シート名").Value) Do Until fname = "" Set wb = Workbooks.Open(fpath & fname) ★コピー元ブック内のシート名に"A"が含まれているシートがある場合以降の処理をする、無かった場合は処理をせず、次のブックへ。。。という事がしたいです。 ★ Aが含まれているシートがあった場合、下記のnoとno2に指定したシートのセルの情報を入れますが指定シートの名前が毎回異なります。仮でSheet1,2とそれぞれしていますが、 noはシート名に"B"という文字が含まれている場合セルA2、no2はシート名に"C"という文字が含まれている場合セルB2の情報を入れるという事をしたいです。 no = wb.Worksheets("Sheet1").Range("A2").Value no2 = wb.Worksheets("Sheet2").Range("B2").Value ★ Withステートメントでコピー元シートを指定して転記処理をしたいのですが、シート名がブック毎に異なります。この場合はどのように指示をすれば良いでしょうか。 With wb.Worksheets("sheet3") 以下転記処理（ここは省略させていただきます） End With wb.Close fname = Dir() Loop Application.ScreenUpdating = True End Sub わかりづらく申し訳ありませが、何卒よろしくお願いします・・・。

質問日時: 2023/05/22 01:43 質問者: たまご3世

ベストアンサー

1

0
vbaマクロについて次のようなマクロを組みたいです。自分は初心者なので全くわかりません。詳しく

vbaマクロについて次のようなマクロを組みたいです。自分は初心者なので全くわかりません。詳しく教えていただけると嬉しいです。 Chat GPTで検索しましたが、ひとつひとつのプログラムが何を起動しているのかがわかりませんでしたので再度ご質問させていただきます。 m(_ _)m 【1.csv】をもとに【商品.csv】に有るものを【有り.csv】として名前をつけてデスクトップに保存したいです。（A列の商品コードをキーにして）【1.csv】も【商品.csv】も、行はそのときにより何行目まで値が入るかわかりません。それぞれ最終行まで値が入る可能性があります。（商品はもっといろいろな種類があります）重複行は削除したいです。（この場合だと、3なしが2行ありますが、1行のみにしたいです）プログラムを教えてほしいです。何卒よろしくお願いします。－－－－－【商品.csv】 A B 1 りんご 2 みかん 3 なし 4 ぶどう 5 メロン 6 バナナ 7 かき 8 いちご【1.csv】 A B C 3 なし 500円 9 パイナップル 1000円 11 ざくろ 400円 5 メロン 3000円 3 なし 500円 1 りんご 100円ーーーーー【有り.csv】 A B C 3 なし 500円 5 メロン 3000円 1 りんご 100円

質問日時: 2023/05/18 18:38 質問者: tomorin_とも

ベストアンサー

8

0
VBA リスト表示していますが

'機器リスト表示 Private Sub UserForm_Initialize() Dim lRow As Long With Worksheets("機器在庫数") lRow = .Range("M" & Rows.Count).End(xlUp).Row End With With ComboBox6 .ColumnCount = 12 .ColumnWidths = "\55;0;60;0;0;0;0;65;0;0;0;30" .RowSource = "機器在庫数!A2:M1000" & lRow End With End Sub 上記内容で転記もできていますプラス参照している機器在庫数!sheetのMをクリアしたいのですがコードとしてはどのように追加したらよいのでしょうか？

質問日時: 2023/05/18 12:12 質問者: ka-.-ji

解決済

3

1
vbaマクロについて【1.csv】をもとに【商品.csv】に有るものを【有り.csv】として名前を

vbaマクロについて【1.csv】をもとに【商品.csv】に有るものを【有り.csv】として名前をつけてデスクトップに保存したいです。（A列の商品コードをキーにして）【1.csv】も【商品.csv】も、行はそのときにより何行目まで値が入るかわかりません。それぞれ最終行まで値が入る可能性があります。重複行は削除したいです。（この場合だと、3なしが2行ありますが、1行のみにしたいです）プログラムがわかるかた教えてください。よろしくお願いします。－－－－－【商品.csv】 A B 1 りんご 2 みかん 3 なし 4 ぶどう 5 メロン 6 バナナ 7 かき 8 いちご【1.csv】 A B C 3 なし 500円 9 パイナップル 1000円 11 ざくろ 400円 5 メロン 3000円 3 なし 500円 1 りんご 100円ーーーーー【有り.csv】 A B C 3 なし 500円 5 メロン 3000円 1 りんご 100円

質問日時: 2023/05/18 07:58 質問者: tomorin_とも

ベストアンサー

1

1
vbaマクロについてシート1のA列にある商品コードがシート2のB列にある商品コードに該当する場合

vbaマクロについてシート1のA列にある商品コードがシート2のB列にある商品コードに該当する場合、シート1の該当する行のみを表示させるさらにシート1を .CSV でデスクトップに保存するこちらのプログラムを教えてください。よろしくお願いします。

質問日時: 2023/05/17 13:41 質問者: tomorin_とも

ベストアンサー

2

0
VBA 検索と入力 Excel ブックぶぶぶシートししし列V 検索対象の列です最終行は、お

VBA 検索と入力 Excel ブック　ぶぶぶシート　　　　ししし列V　　　　　検索対象の列です最終行は、およそ2万行目、ただし毎月　変わるしたいことは、列 V について一番上から下まで各セルを検索しブック　ぶぶぶシート　たたた列A　の縦方向に　格納した単語に合致する場合は例えばシート　ししし列 V について任意のセルV３０に関して私は、畑でバナナを収穫したと入力がありシート　たたた列A　の　任意のセルA5　にある　バナナ　に検索がヒットした時にシート　ししし　セルV３０　と　同じ行で別の任意の列例えば Z 30に、シート　たたた該当セルA５　と同じ行　E５に格納された任意の単語　ジャガイモ　　をシート　しししセルZ30　に　入力したいこれをコーディングで教えてくださいシート　たたた　はいわば単語帳であり置き換え前と置き換え後の単語が縦方向にずらっと複数並んでおり最終行は７０００行くらいで　増える方向において可変的です

質問日時: 2023/05/17 01:40 質問者: pythons5

ベストアンサー

6

2
VBAのifで

VBAのif文で下記コードを書いています（コード一部） If Me.TextBox6 >= Me.TextBox4 And Me.TextBox6 <= Me.TextBox4 Then ユーザーフォームのTextBox6に入力されている数値を TextBox4(最小値)、TextBox5(最大値)の数値と比較して範囲なら処理に進むコードなのですが TextBox4、TextBox5に入力されている桁がどちらも同じ桁なら問題なく動作するのですが、TextBox４が2桁、TextBox5が3桁だと正しく動作しません。原因や、修正コードを教えてください。

質問日時: 2023/05/16 14:21 質問者: 優也。

ベストアンサー

4

0
userformでSheetを選択して開くコード

Private Sub UserForm_Initialize() Dim MyList() As Variant Dim i As Integer With UserForm1.ListBox1 '1つだけ選択 .MultiSelect = fmMultiSelectSingle 'チェックボックス表示 .ListStyle = fmListStyleOption ReDim Preserve MyList(Sheets.Count) 'シート名を取得 For i = 1 To Sheets.Count MyList(i) = Sheets(i).Name Next i 'リストボックスに追加 For i = 2 To UBound(MyList) .AddItem MyList(i) Next i End With End Sub こちらで行っておりますがすべてのsheetではなくSheet1～10までのうち１～4までをリストボックスに表示させたい場合はどのようなコードが適切でしょうか？

質問日時: 2023/05/15 16:27 質問者: ka-.-ji

ベストアンサー

1

0
空白を全て削除したい

いつもお世話になっております下記のように　半角　全角　の空白を削除する方法わかる方おしえてくれませんでしょうか下記のコードは全角だけ削除されてしまいます。 1 と2　を入れ替えると玉に半角だけ削除されます。 For Each r In Range("E11", Cells(Rows.Count, "E").End(xlUp)) r.Offset(, 1).Value = Replace(r, " ", "")　　'1 r.Offset(, 1).Value = Replace(r, "　", "") '2 Next 近　藤佐藤近　藤佐藤

質問日時: 2023/05/13 21:36 質問者: りんごプリン

ベストアンサー

2

0
Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。

Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。エクセルブック名　あああこれはマクロファイルですブック名　あああシート名　しししシート名　すすすシート名　せせせシート名　そそそこれらのシート名は左から右方向に並んでいますししし　すすす　せせせ　そそそシート名　ししし　の構成は 1行目が様々な見出しで　ぎっしり。見出し名が必要なら、 A1は　あ B１は　い C1は　う　以下同様。ただしセルJ１　　担当名セルAN１　支店名タテの方向にはA列からAL列まで　データが、びっしりあります。最終行は　未定で、経験的には２万から4万行で　作業の度に異なるため不安定ですシート名　そそそ　の構成セルA1　担当名セルB１　いいいセルC１　支店名行は５０行固定です VBA内容データ満載の　シート名　ししし　ごと　同じブックの新規シートへコピーし、シート名をシシシ。そのシート上で VBA を適用しVLOOKUP 関数を担当名ごとに支店名を最終行まで割り当てたいです

質問日時: 2023/05/11 13:14 質問者: pythons5

ベストアンサー

3

1
フォルダの場所を可変にしたいです(マクロ)

以下のVBAコードだとフォルダの場所が決まってしまっているのでフォルダの場所を　sheet2のセルB2へ記載した「D:\users\○○￥～」みたいに場所を都度指定できるようにしたいです。可能でしょうか？？ ※ちなみにフォルダパスのところでsheet2.B2を指定してみたのですが　うまく動きませんでした・・・お力お貸しいただけますと幸いです。よろしくお願いいたします。 Sub merge() Dim Folder_path As String, buf As String, Target As Worksheet Dim LastCol As Long, TargetR As Long, TargetC As Long Dim ctr As Long: ctr = 0 Application.ScreenUpdating = False With Sheets("Sheet1") '1行目クリア、2行目以降を削除 .Rows(1).ClearContents .Rows("2:" & Rows.Count).Delete 'フォルダの場所 Folder_path = "D:\Sample\CSV\" 'ファイルを順番に開く buf = Dir(Folder_path & "*.csv") Do While buf <> "" ctr = ctr + 1 Workbooks.Open Folder_path & buf, ReadOnly:=True 'CSVシート名を変数に入れる Set Target = Workbooks(buf).Sheets(Split(buf, ".")(0)) 'mergeシートのA1基準での最終列 LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column '開いたシートのA1基準での最終行、最終列 TargetR = Target.Cells(Rows.Count, 1).End(xlUp).Row TargetC = Target.Cells(1, Columns.Count).End(xlToLeft).Column '値で転記 If ctr = 1 Then .Range(.Cells(1, LastCol + 1), .Cells(TargetR, LastCol + TargetC)).Value = _ Target.Range(Target.Cells(1, 1), Target.Cells(TargetR, TargetC)).Value Else .Range(.Cells(1, LastCol + 1), .Cells(TargetR, LastCol + TargetC - 2)).Value = _ Target.Range(Target.Cells(1, 3), Target.Cells(TargetR, TargetC)).Value End If '次へ Workbooks(buf).Close False buf = Dir() Loop '空白のA列削除 .Range("A:A").Delete Application.ScreenUpdating = True MsgBox "END" End With End Sub

質問日時: 2023/05/11 10:00 質問者: 脱走ルンバ

解決済

4

0
vbaマクロについて【シート2】をもとに【シート1】に有るものを｢有り.csv｣としてデスクトップ

vbaマクロについて【シート2】をもとに【シート1】に有るものを｢有り.csv｣としてデスクトップに保存、無いものを｢無し.csv｣としてデスクトップに保存になるようマクロを作成したいです。プログラムがわかるかた教えてください！【シート1】 A B 1 りんご 2 みかん 3 なし 4 ぶどう 5 メロン 6 バナナ 7 かき 8 いちご【シート2】 A B 0003 なし 500円 0009 パイナップル 1000円 0011 ざくろ 400円 0005 メロン 3000円 0001 りんご 100円ーーーーー【有り.csv】 A B 0003 なし 500円 0005 メロン 3000円 0001 りんご 100円【無し.csv】 A B 0009 パイナップル 1000円 0011 ざくろ 400円

質問日時: 2023/05/07 22:30 質問者: tomorin_とも

ベストアンサー

3

0
VBA 配列を使ったコードに直していただけますか

"3種の板があります。板の巾はWaミリ、Wbミリ、Wcミリです。同じ巾の板は5枚まで使える事とします。全ての板の組み合わせをワークシートsh1のA1から書き出す事とします。また、表記はWaＸ1､WbＸ0､WcＸ5 という風にします。下記コードで動くのですが、板の種類や、同じ板を使える枚数を増やすと、シートへの書き出し時間が何時間も掛かってしまいます。下記コードを配列に直していただけないでしょうか。私は配列が苦手なものですので。 Sub 全ての板の組み合わせを書き出す() Dim Wa As Integer, Wb As Integer, Wc As Integer '板の巾 Dim i As Integer, j As Integer, k As Integer 'カウンター変数 Sheets(""sh1"").Range(""A1"").Value = ""組み合わせ"" '表の見出しを書き出す 'すべての板の組み合わせを書き出す For i = 0 To 5 'Waの板の数を0から5まで変化させる For j = 0 To 5 'Wbの板の数を0から5まで変化させる For k = 0 To 5 'Wcの板の数を0から5まで変化させる Sheets(""sh1"").Range(""A"" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ ""Wa"" & ""x"" & i & "", Wb"" & ""x"" & j & "", Wc"" & ""x"" & k '組み合わせを書き出す Next k Next j Next i End Sub"

質問日時: 2023/05/06 15:18 質問者: ニックネーム船長

ベストアンサー

4

0
エクセル365のＶＢＡで困っています。どう修正したらよいか添削をお願いします

エクセルＶＢＡで思うような動きができなく困っています。どう修正したらよいか添削をお願いします。エクセル３６５です ≪困っていること≫ １～４は思うように動くのですが、５がどうしてもできません印刷した紙と画面表示が「支」のフォントカラーが黒になってしまします。 ≪行いたいこと＆今の状況≫ 【ＶＢＡで】１、常に選択したセルがある行全体を色付け表示します。２、印刷する時は、その色付けした行の色は印刷されないようにします。３、印刷後は、再度常に選択したセルがある行全体が色付け表示されるように戻します。【シートで】４、条件付き書式で「Ｃ列に「支」と入力されたときはフォントカラーを赤色になるように設定しています。５、このフォントカラーは印刷する紙にも印刷後も常に設定されたままにします【今書いてあるコード】 Option Explicit Private Sub Workbook_BeforePrint(Cancel As Boolean) ThisWorkbook.Worksheets(1).Cells.FormatConditions.Delete Application.ScreenUpdating = True Application.OnTime Now(), "ThisWorkbook.AfterInsatsu" End Sub Private Sub AfterInsatsu() Dim Rng As Range Dim Frm As Object With ThisWorkbook.Worksheets(1) Set Rng = Worksheets(1).Cells Set Frm = Rng.FormatConditions.Add(Type:=xlExpression, Formula1:="=CELL(""ROW"")=ROW()") Frm.Interior.Color = RGB(198, 224, 180) End With Application.ScreenUpdating = True End Sub

質問日時: 2023/05/03 17:35 質問者: satopower

解決済

2

0
指定文字以外のカウント

H列から指定した文字（東京）のカウントをすることは下記コードでできたのですが、H列から指定した文字（東京、神奈川、千葉、埼玉）以外をカウントするにはどのようにしたら良いか教えてください。カウントした結果は、その他セルF4へ表示したいです。図ですとその他は４になります。 Sub sample() Cells(4, 2) = WorksheetFunction.CountIf(Range("H4:H18"), "東京*") End Sub

質問日時: 2023/05/03 14:37 質問者: momo_2123

ベストアンサー

4

1
VBAで、シート間の転記するコードをFOR～NEXTで教えてください。

シート間の転記VBAのコードを記載中ですが、このコードではエラーも出ず、全く転記できません。下記の内容でどのようにコードを修正すれば、転記できますでしょうか？ご教授の方お願いします。【やりたい事】・A.xlsmにAシート、Bシートがあります。下記①～⑧の内容で、AシートからBシートに転記します。 ①Aシートの1列目と、Bシート4列目が同じ場合 ②かつAシートの7列目、および8列目に何も記載がない場合 ③Bシート6列目の数量に合う個数まで ④下記を転記・Aシートの3列目のデータを、Bシートの10列目へ転記・Aシートの4列目のデータを、Bシートの11列目へ転記 ⑤Aシートの1列目と、Bシート4列目が同じ場合 ⑥かつAシートの7列目、および8列目に何も記載がない場合 ⑦下記を転記 Aシートの4列目各車種名毎に、それぞれ最大4つのデータを、 ④で転記した続きの製造NOを、予備としてAシートから下記を転記・Aシートの3列目のデータを、Bシートの10列目へ転記・Aシートの4列目のデータを、Bシートの11列目へ転記 ⑧Aシートの1列目と、Bシート4列目が同じ場合 ⑨かつAシートの7列目、および8列目に何も記載がない場合 ⑩かつBシートの4列目に、同じ車種名があり、3列目に行先が違う物がある場合 ⑦で転記した続きの製造NOを、予備としてAシートから下記を転記・Aシートの3列目のデータを、Bシートの10列目へ転記・Aシートの4列目のデータを、Bシートの11列目へ転記 ⑪AシートのG列またはH列に"○"がある場合⑩ ⑩で転記した続きの製造NOを、×としてAシートから下記を転記・Aシートの3列目のデータを、Bシートの10列目へ転記・Aシートの4列目のデータを、Bシートの11列目へ転記【VBAコードの書きかけ途中の物】 Sub TENNKI() Dim lastRowA As Long Dim lastRowB As Long Dim i As Long Dim j As Long Dim k As Long Dim 車種名 As String Dim orderNo As String Dim quantity As Long Dim maxCount As Long Dim rowCount As Long Dim count As Long lastRowA = Sheets("A").Cells(Rows.count, 1).End(xlUp).Row lastRowB = Sheets("B").Cells(Rows.count, 4).End(xlUp).Row For i = 5 To lastRowA 車種名 = Sheets("A").Cells(i, 1).Value For j = 1 To 4 rowCount = 0 count = 0 For k = 5 To lastRowB If Sheets("B").Cells(k, 4).Value = 車種名 Then rowCount = rowCount + 1 If Sheets("B").Cells(k, 8).Value <> "" Then quantity = Sheets("B").Cells(k, 8).Value End If End If Next If count >= quantity Or rowCount = 0 Then Exit For End If If Sheets("A").Cells(i, 1).Value = Sheets("B").Cells(k, 4).Value _ And Sheets("A").Cells(i, 7).Value = "" _ And Sheets("A").Cells(i, 8).Value = "" Then Sheets("B").Cells(k, 10).Value = Sheets("A").Cells(i, 3).Value Sheets("B").Cells(k, 11).Value = Sheets("A").Cells(i, 4).Value count = count + 1 End If Next End Sub すみませんが、よろしくお願いいたします。

質問日時: 2023/04/30 20:04 質問者: qazwsx7410

ベストアンサー

9

2
A列B列C列

Sub showMostFrequentNumber1() Dim i As Integer Dim count(1 To 10) As Integer Dim maxcount As Integer For i = 1 To 10 count(i) = Application.CountIf(Range("A1:A10"), Cells(i, 1).Value) If i = 1 Then maxcount = count(i) ElseIf count(i) > maxcount Then maxcount = count(i) End If Next i For i = 1 To 10 If count(i) = maxcount Then Range("A15").Value = Cells(i, 1).Value End If Next i End Sub -------------- Sub showMostFrequentNumber2() Dim i As Integer Dim count(1 To 10) As Integer Dim maxcount As Integer For i = 1 To 10 count(i) = Application.CountIf(Range("B1:B10"), Cells(i, 1).Value) If i = 1 Then maxcount = count(i) ElseIf count(i) > maxcount Then maxcount = count(i) End If Next i For i = 1 To 10 If count(i) = maxcount Then Range("B15").Value = Cells(i, 1).Value End If Next i End Sub コピペでA列B列の答えはオッケイですが C列D列E列F列G列では答えが違うどうしてですかマクロ名もセルの番号も修正したのに

質問日時: 2023/04/26 18:11 質問者: よへ

ベストアンサー

3

0
エクセル VBAについて教えてください

お世話になります。 "時間外請求"というフォルダ　に"時間外請求"というエクセルファイル（このファイル）と"履歴"というフォルダがあり、”履歴”というフォルダの中には”2020年度”～”2023年度”というフォルダが４個あります。シートのX1にファイル名、Y1に”2023年度”と入力し、ボタンを押すと"2023年度"というフォルダにX1のファイル名で保存しようと思います。でもボタンを押すと原本（時間外請求）と同じフォルダに”2023年度履歴”というファイル名で保存されてしまいます。よろしくお願いいたします Sub 保存() Dim wb As Workbook Dim ws As Worksheet Dim hozonPath As String Dim FolName As String Dim FilName As String Set wb = ThisWorkbook Set ws = ActiveSheet hozonPath = ThisWorkbook.Path FolName = ws.Range("y1").Value FilName = ws.Range("x2").Value wb.SaveAs Filename:=hozonPath & "\履歴" & FolName & FilName End Sub

質問日時: 2023/04/26 13:25 質問者: 60majika

解決済

2

0
エクセルマクロ(A1:A10)までの中で一番多く出た数字をB10に表示

Sub showMostFrequentNumber() Dim i As Integer Dim count(1 To 10) As Integer Dim maxCount As Integer For i = 1 To 10 count(i) = Application.CountIf(Range("A1:A10"), i) If i = 1 Then maxCount = count(i) ElseIf count(i) > maxCount Then maxCount = count(i) End If Next i For i = 1 To 10 If count(i) = maxCount Then Range("B10").Value = i End If Next i End Sub

質問日時: 2023/04/25 17:01 質問者: よへ

解決済

6

1
ExcelVBAで配列２つを結合させて重複アドレスを削除したいです

ExcelA列、B列の2行目からメールアドレスが行方向に複数記載されている状態で、条件が合うときにA列、B列記載のメールアドレス両方にメール配信したいため、配列２つを結合させて重複アドレスを削除したいです。どうすればできるでしょうか。

質問日時: 2023/04/25 15:31 質問者: ハクチャン。

ベストアンサー

3

0
Excel VBA 教えてください。 VBA初心者です。詳しい方がいましたら教えてください。下記

Excel VBA 教えてください。 VBA初心者です。詳しい方がいましたら教えてください。下記のURLを参考に、エクセルからWordの文字を置換するようなマクロを作ろうとしています。 https://touch-sp.hatenablog.com/entry/2017/04/11/185127 ====== with wdDoc.Content.Find .Text = "置換前" .Replacement.Text = "置換後" .Forward = True .Execute Replace:=2 ====== このコードの“置換前”と“置換後”の部分を sheet1に入っているセル、 “置換前”はA2のセルの文字列（例:会社名） “置換後”はB2のセルの文字列（例:〇〇商事） A2の文字をB2にするみたいな感じにしたいのですが、いまいちうまくいきません。どのように書けばいいか教えていただけると助かります…。何卒よろしくお願いいたします。置換後

質問日時: 2023/04/25 11:22 質問者: ramgdja

ベストアンサー

3

0
VBAで列の再表示設定

横表示の表があり最終列に合計が記載されています列に記入がない場合は非表示で記入列が増えたら再表示するようなVBAコードできるのでしょうか？記入列：A列各行には記入済みでC列からｘ列まで未記入なので非表示にしていますなのでＢ列の次はＹ列になっています B3に日付・B4以下個数を入力するとします、B列に何かしら入力があったらC列が再表示できればと思います

質問日時: 2023/04/25 10:19 質問者: ka-.-ji

ベストアンサー

1

0
複数csvを横に追加していくマクロについて

複数のCSVを横に追加していくマクロを作る必要があり、なんとか動きそうなコードを見つけました。 A列とB列を抜かしてC1セルから最終列と最終行（CSVによって最終列がバラバラです。最終行は同じ数です。）を取得して貼り付けることをしたいのですが、こちらのコードだと、A1セルからの貼り付けとなっています。 VBA初心者過ぎて、色々調べたりセルの値を変えたりしてみましたがうまくいきません。どなたか教えていただけませんでしょうか。よろしくお願いいたします。 Sub merge() Dim Folder_path As String, buf As String, Target As Worksheet Dim LastCol As Long, TargetR As Long, TargetC As Long Application.ScreenUpdating = False With Sheets("Sheet1") '1行目クリア、2行目以降を削除 .Rows(1).ClearContents .Rows("2:" & Rows.Count).Delete 'フォルダの場所 Folder_path = "D:\Sample\CSV\" 'ファイルを順番に開く buf = Dir(Folder_path & "*.csv") Do While buf <> "" Workbooks.Open Folder_path & buf, ReadOnly:=True 'CSVシート名を変数に入れる Set Target = Workbooks(buf).Sheets(Split(buf, ".")(0)) 'mergeシートのA1基準での最終列 LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column '開いたシートのA1基準での最終行、最終列 TargetR = Target.Cells(Rows.Count, 1).End(xlUp).Row TargetC = Target.Cells(1, Columns.Count).End(xlToLeft).Column '値で転記 .Range(.Cells(1, LastCol + 1), .Cells(TargetR, LastCol + TargetC)).Value = _ Target.Range(Target.Cells(1, 1), Target.Cells(TargetR, TargetC)).Value '次へ Workbooks(buf).Close False buf = Dir() Loop '空白のA列削除 .Range("A:A").Delete Application.ScreenUpdating = True MsgBox "END" End With End Sub

質問日時: 2023/04/25 09:19 質問者: 脱走ルンバ

ベストアンサー

2

0
VBAでWordのネストした表にデータを挿入したい

VBA初心者の質問です。　Word文書に表があってそのネストした表（親表の子表）にVBAを使用してデータを挿入したい。色々調べてみたが、見つかりませんでした。どなたがご教授をお願いします。

質問日時: 2023/04/24 10:18 質問者: SYO_770411

解決済

4

1
vbaのエラー対応（実行時エラー7：メモリが不足しています)

xmlファイルを開いて順にコピペする記述です。処理は一応できているのですが、処理が終わった後に、タイトルにある実行時エラー７がいつも出てしまい、気持ち悪いです。どのように記述を訂正すればいいか、アドバイスいただけないでしょうか。 Sub OpenFilesInFolder() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim path, fso, file, files Dim target As Long path = ThisWorkbook.path & "\" 'xmlﾌｧｲﾙを開く処理 Set fso = CreateObject("Scripting.FileSystemObject") Set files = fso.GetFolder(path).files 'フォルダ内の全ファイルについて処理 For Each file In files 'ファイルを開いてブック、シートとして取得 Dim wb As Workbook Dim ws As Worksheet 'xmlﾌｧｲﾙを開く処理 Workbooks.OpenXML _ Filename:=file.path, LoadOption:=xlXmlLoadImportToList Set wb = ActiveWorkbook Set ws = ActiveSheet '開いたxmlﾌｧｲﾙを順にコピペ処理 With ThisWorkbook.Worksheets(1) target = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ws.Range(ws.Cells(2, 25), ws.Cells(49, 25)).Copy .Range(.Cells(target, 1), .Cells(target + 47, 1)).PasteSpecial Paste:=xlPasteValues ws.Range(ws.Cells(2, 27), ws.Cells(49, 27)).Copy .Range(.Cells(target, 2), .Cells(target + 47, 2)).PasteSpecial Paste:=xlPasteValues ws.Range(ws.Cells(2, 28), ws.Cells(49, 28)).Copy .Range(.Cells(target, 3), .Cells(target + 47, 3)).PasteSpecial Paste:=xlPasteValues End With '保存せずに閉じる wb.Close SaveChanges:=False Next file DoEvents Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

質問日時: 2023/04/24 00:20 質問者: puyopa

ベストアンサー

4

0
VBA。壁の間隔Ｘミリの中に、5種類の異なる巾の板を敷き詰め、Ｘ以下でＸに近い板の組み合わせを算出

エクセルVBA。A列1行目に板の名称ａ、2行目にb、3行目にｃ、4行目にｄ、5行目にｅが記入されています。Ｂ列にそれぞれの板の巾が記入されています。（ミリ表示）壁の間隔Ｘミリに敷く板の組合わせでＸに一番近い板の組み合わせを求め、その時の板の合計巾を提示するマクロを教えて下さい。

質問日時: 2023/04/23 21:33 質問者: ニックネーム船長

ベストアンサー

6

0
vb.net webからダウンロードできない

http://nonsoft.la.coocan.jp/SoftSample/VB.NET/SampleWebFtpDwn.html このサイトにあるWEBダウンロードというのを実行してみたのですが、どこにも保存されません。どうすれば保存できるようになるのでしょうか。ネットから取り込みたいGZIPファイルがあって、ようやくこのサイトを見つけたのですが。他のサイトにあるのも試したのですがどうしてもゼロバイトになってしまいます。

質問日時: 2023/04/23 18:16 質問者: payphone

ベストアンサー

3

0
エクセルVBA（実行時エラー438）の対処法を教えてもらえないでしょうか

下記、xmlファイルを開いてコピペするというvbaの記述です。しかし、 ThisWorkbook.Worksheets(1).Range(Cells(target, 1), Cells(target + 287, 1)) = wb.Range(Cells(2, 25), Cells(289, 25)) の行で、実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。とエラーが出てしまいます。どのように修正したらいいかおしえていただけないでしょうか。 Sub OpenFilesInFolder() Dim path, fso, file, files Dim target As Long path = ThisWorkbook.path & "\" Set fso = CreateObject("Scripting.FileSystemObject") Set files = fso.GetFolder(path).files 'フォルダ内の全ファイルについて処理 For Each file In files 'ファイルを開いてブックとして取得 Dim wb As Workbook Workbooks.OpenXML _ Filename:=file.path, LoadOption:=xlXmlLoadImportToList Set wb = ActiveWorkbook ' MsgBox wb.Name 'ブックに対する処理 target = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets(1).Range(Cells(target, 1), Cells(target + 287, 1)) = wb.Range(Cells(2, 25), Cells(289, 25)) ThisWorkbook.Worksheets(1).Range(Cells(target, 2), Cells(target + 287, 2)) = wb.Range(Cells(2, 27), Cells(289, 27)) ThisWorkbook.Worksheets(1).Range(Cells(target, 3), Cells(target + 287, 3)) = wb.Range(Cells(2, 28), Cells(289, 28)) '保存せずに閉じる Call wb.Close(SaveChanges:=False) Next file End Sub

質問日時: 2023/04/22 13:43 質問者: puyopa

ベストアンサー

3

0
vbaの構文の修正相談（xmlファイルを順に開いてコピペ作業）

下記、vbaの構文の修正を教えて頂けないでしょうか。 xmlファイルを順に開いて、コピペする作業をしたいのですが、下記内容だと、xmlファイルが表形式で正しく開かず、コピペがうまくできません。 Sub OpenFilesInFolder() Dim path, fso, file, files Dim target path = ThisWorkbook.path & "\" Set fso = CreateObject("Scripting.FileSystemObject") Set files = fso.GetFolder(path).files 'フォルダ内の全ファイルについて処理 For Each file In files 'ファイルを開いてブックとして取得 Dim wb As Workbook Set wb = Workbooks.Open(file) 'ブックに対する処理 target = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 wb.Range(Cells(2, 25), Cells(289, 25)) = Cells(target.Row, 1) wb.Range(Cells(2, 27), Cells(289, 27)) = Cells(target.Row, 2) wb.Range(Cells(2, 28), Cells(289, 28)) = Cells(target.Row, 3) '保存せずに閉じる Call wb.Close(SaveChanges:=False) Next file End Sub

質問日時: 2023/04/22 01:18 質問者: puyopa

ベストアンサー

1

0
ExcelのVBAコードについて教えてください。

作業ブックのシート名「300」に設定するVBAコードについて教えてください。セル「F2」～「F12」にそれぞれ「確認必要」又は「確認不要」のいずれかが表示されます。（各セルに重複して表示される場合もあります。）セル「F2」～「F12」のどれかに「確認必要」が表示された場合にメッセージBOXが起動しはい（Y）をクリックするとマクロ「便利帳比較ひな形」が実行されいいえ（N）をクリックするとメッセージBOXがクローズできる方法を教えてください。メッセージの文章は「内容が変更されております、確認をお願いします。」としてください。メッセージBOXの参考画像をお送りいたします。画像のように「？」マークも設定をお願いします。詳しい方、よろしくお願いします。

質問日時: 2023/04/21 13:46 質問者: エクセル小僧

ベストアンサー

1

0
【VBA】もし、値が0だったら左のセルと合わせて削除したい

グラフ作成用のデータです。XYを横に並べて入力しています。 Y列（B・D・F列）が”0”の場合、X列（A・C・E列）とともに削除して上方向にシフトしたい。（添付画像でグレーに塗りつぶしてある範囲）これが数百あるため、自動処理をしたいのですが、VBA全くの初心者です。説明もわかりにくくてすみません。どなたかわかりやすく教えていただきたいです。よろしくお願いいたします。 Excel2016使用です。

質問日時: 2023/04/20 10:12 質問者: yk9390

ベストアンサー

3

0
リストボックスに表示されたファイルを削除したい

いつもお世話になっております下記コードでおしえてくれませんでしょうかリストボックスに表示されたファイルを削除する方法下記のコードはリストボックスに表示されたのだけ削除になります。 .List(.ListCount - 1, 1) = f.Pathにファイルが表示されます。わかる方おしえてくれませんでしょうか Private Sub CommandButton2_Click() With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then .RemoveItem (i) End If Next End With End Sub Private Sub CommandButton1_Click() Dim fso As Object Dim pathN As String Set fso = CreateObject("Scripting.FileSystemObject") Dim f With ListBox1 .Clear .ColumnCount = 2 .ColumnWidths = "250;15" .Font.Size = 14 .MultiSelect = fmMultiSelectSingle For Each f In fso.getfolder("C:\Users\デスクトップ\aa\").files .AddItem "" .List(.ListCount - 1, 0) = f.Name .List(.ListCount - 1, 1) = f.Path Next End With End Sub

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

解決済

1

1
Excel vbaについての質問

ほとんどが実行できますが時折エラーが出て中断されます。エラー時の文章：実行時エラー 1004 rangeクラスのcopypictureメソッドが失敗しました。エラーが起きる場所も毎回バラバラで、本来はタスクスケジューラで毎時自動で実行したいものなのでエラーが何とか起きないようにしたいです。エラーが起きる場所は主に各範囲のpic.Chart.Pasteか、各範囲それぞれのexportRange2.CopyPicture Appearance:=xlScreen, Format:=xlPicture この部分です。助けてほしいですお願いします。 Private Sub Workbook_Open() Dim FileSize As Long Dim pic As ChartObject Dim picName As String Dim picName2 As String Dim picName3 As String Dim picName4 As String Dim rng As Range Dim exportRange2 As Range Dim exportRange3 As Range Dim exportRange4 As Range Dim wb As Workbook: Set wb = ThisWorkbook Dim ws As Worksheet Dim path As String Dim retryCounter As Integer path = "C:\???\???\???\???\???\???\" Application.DisplayAlerts = False Application.ScreenUpdating = False For Each ws In Worksheets Select Case ws.Name Case "報告書" picName = path & "image" & "1.png" Set rng = ws.Range("D4:N52") Application.Wait (Now + TimeValue("0:00:01")) rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set pic = ws.ChartObjects.Add(0, 0, rng.Width, rng.Height) pic.Name = "ChartObject3" pic.Chart.Export picName FileSize = FileLen(picName) If FileLen(picName) <= FileSize Then pic.Chart.Paste pic.Chart.Export picName End If pic.Delete Set pic = Nothing Case "グラフ" '範囲1 picName2 = path & "image" & "2.png" Set exportRange2 = ws.Range("A1:Y35") Application.Wait (Now + TimeValue("0:00:01")) exportRange2.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set pic = ws.ChartObjects.Add(0, 0, exportRange2.Width, exportRange2.Height) pic.Name = "ChartObject2" pic.Chart.Export picName2 FileSize = FileLen(picName2) If FileLen(picName2) <= FileSize Then pic.Chart.Paste pic.Chart.Export picName2 End If pic.Delete Set pic = Nothing '範囲2 picName3 = path & "image" & "3.png" Set exportRange3 = ws.Range("A36:Y70") Application.Wait (Now + TimeValue("0:00:01")) exportRange3.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set pic = ws.ChartObjects.Add(0, 0, exportRange3.Width, exportRange3.Height) pic.Name = "ChartObject3" pic.Chart.Export picName3 FileSize = FileLen(picName3) If FileLen(picName3) <= FileSize Then pic.Chart.Paste pic.Chart.Export picName3 End If pic.Delete Set pic = Nothing '範囲3 picName4 = path & "image" & "4.png" Set exportRange4 = ws.Range("A71:Y105") Application.Wait (Now + TimeValue("0:00:01")) exportRange4.CopyPicture Appearance:=xlScreen, Format:=xlPicture Set pic = ws.ChartObjects.Add(0, 0, exportRange4.Width, exportRange4.Height) pic.Name = "ChartObject4" pic.Chart.Export picName4 FileSize = FileLen(picName4) If FileLen(picName4) <= FileSize Then pic.Chart.Paste pic.Chart.Export picName4 End If pic.Delete Set pic = Nothing Case Else GoTo NextSheet End Select NextSheet: Next ws ThisWorkbook.Save Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Quit End Sub

質問日時: 2023/04/18 16:14 質問者: blueham555

解決済

3

1
VBAでシートの保護をかける際に「書式設定の変更」を有効にする

VBAでシートの保護をかける際に、「書式設定の変更」と「オートフィルターの使用」にチェックを入れたい（操作可能にしたい）のですが、どのように記述すればよいでしょうか？　①のオートフィルタ―にチェックまでは正常に動作するのですが、AIさんに訊ねたところ「FormatCells:=True」を追加し②のように変更しろとのことで試しましたがエラーになります。 ①ws1.Protect Password:="pass", AllowFiltering:=True, UserInterfaceOnly:=True ②ws1.Protect Password:="pass", AllowFiltering:=True, UserInterfaceOnly:=True, FormatCells:=True 上記につきましてご回答いただけましたら幸いです。以上、よろしくお願い申し上げます。

質問日時: 2023/04/17 18:18 質問者: maru11586

ベストアンサー

1

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

マクロを実行し、ファイル名を指定してワードのブックを開くように設定しております。マクロコードの一部「Path = "\\nas-sp01\share\確認部\■共通\審査の注意点\□べんり帳（最新）\" _ & Format(DateSerial(Year(Date), ((Month(Date) - 1) \ 3) * 3 + 1, 1), "YYYY.MM") & "点検\SPb-100 【北海道・北海道】建築確認べんり帳2023.4.28.doc" Set WordApp = CreateObject("Word.Application") WordApp.Visible = True」です。指定ファイル名「\SPb-100 【北海道・北海道】建築確認べんり帳2023.4.28.doc"」の一部の建築確認便利帳から後ろの「2023.4.28」の部分が都合により変更されます。「2023.4.28」が指定ファイル名に無くとも、又は変更されても、同じ指定したファイルを開く方法を教えてください。よろしくお願いいたします。

質問日時: 2023/04/17 13:07 質問者: エクセル小僧

ベストアンサー

1

0
転記マクロ変数が定義されていませんの解決法

マクロ初心者です。勉強しながら、転記マクロを作成したのですが、どうしてもうまくいかないところがあります。変数定義がされていませんと表示されてしまい、どう書き直せばよいか、悩んでいます。教えていただけないでしょうか。よろしくお願いします。 Option Explicit '変数　nyuuryoku,MasuterRange Sub tenki() Dim nyuryoku As Range, MasuterRange As Range Set nyuryoku = Worksheets("A").Cells(10, 3) Set MasterRange = Worksheets("B").Cells(4, 3) MasterRange.Value = nyuryoku.Value MasterRange.Offset(12, 0).Value = nyuryoku.Offset(0, 1).Value End Sub

質問日時: 2023/04/16 16:46 質問者: なのか253

解決済

2

0
VBAのSelectedIndexでコンパイルエラーが…

ユーザフォーム中のコンボボックスcmbSheetNameに5個のアイテムを登録しています。次のステートメントで、先頭のアイテムをデフォルトしようとしましたがエラーとなります。　　cmbSelectName.SelectedSheet = 0 エラーは、「コンパイルエラー　メソッドまたはデータメンバーがみつかりません。」です。対策方法をご教示お願いします。

質問日時: 2023/04/16 14:07 質問者: isunsun

ベストアンサー

1

0
VBAでプロセデュア間で共有できるエリアの設定方法は？

以前、ExcelのVBAでプロセデュア間での情報の受け渡しに使用できるエリアを使用しました。しかし、その方法をすっかり忘れてしまいました。どのブックで使用したかも調べましたが分かりませんでした。確か[参照の追加]とかをしたような気がしますが？現在作成中のアプリで以前の方法を使用したく、その方法をご教示頂きたくお願いします。先にこの場でVBAの質問した際、頂いた回答にベストアンサーをしないで失礼な終了の仕方をしてしまいました。この場を借りて解答者にお詫び致します。お許しください。

質問日時: 2023/04/15 19:06 質問者: isunsun

ベストアンサー

3

0
別シートに順番で貼り付け

Sheet1のB1から最終行までの値を、マクロを実行する度にSheet2のA列からB列・C列・・へと順に貼り付けたいです。 B列の行数は決まっていません。例えばSheet1でB1からB5にそれぞれ1,2,3,4,5,と入力してマクロを実行するとSheet2のA1から下へ貼り付け、手動でSheet1に戻ってB列を手動で消去してB1からB6に6,7,8,9,10,11と入力してマクロを実行するとSheet2のB1から下へ貼り付け、という動きにしたいです。これをVBAで行いたいです。お詳しい方宜しくお願いいたします。

質問日時: 2023/04/13 19:53 質問者: さわ子

ベストアンサー

2

0
Excel VBAでの右クリックのポップアップメニューの非表示方法は？

右クリックイベントハンドラでユーザフォームを表示すると、同時に右クリックのポップアップメニューも表示されます。このポップアップメニューを非表示にする方法があれば、ご教示して頂きたくお願いします。右クリックハンドラは下記です。 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _ 　　　　　　　　　　　　　　　　ByVal Target As Range, Cancel As Boolean) 　　frmSelectSheet.Show vbModeless End Sub

質問日時: 2023/04/12 17:03 質問者: isunsun

ベストアンサー

1

0
A列に重複した番号の行を条件を指定して削除

A列に番号が入力されています、何行あるかは決まっていません。 A列に同じ番号があった場合、2個隣のC列にある値が一番大きい行だけ残して他の行を削除したいです。重複は何個あるかわかりません。 VBAで可能でしょうか？宜しくお願いいたします。

質問日時: 2023/04/11 05:47 質問者: さわ子

ベストアンサー

4

0
Selenium Basicの件

いつも大変お世話になっております。要素を取得してテキストボックスに文字を入力したくて色々試しているのですがうまくいきません。 <div class="form__group__itemBox--narrow"> <input type="text" class="form__item js-doc-note" id="doc-note" placeholder="送信先の会社名などを入力してください" value="" data-doc_id="01j37x28kvp74h2m8tw9q6k9k3nwz7qw"> </div> 上記の要素の箇所を driver.FindElementByXPath("//*[@id="""doc-note""]/form/input").SendKeys "test" のコードで取得して入力をしたいのですが、エラーになります。どなたかご教示頂ける方いらっしゃいましたらよろしくお願いいたします。

質問日時: 2023/04/10 20:55 質問者: 太郎です

ベストアンサー

5

0

←前の結果
1
...
7
8
9
10
11
12
13
14
15
16
17
...
20
次の結果→

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

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

質問する（無料）

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

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

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

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

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

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