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

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

回答数

気になる

ユーザーフォームに別シートからデータを反映させたい。

今回初めてマクロを使って入力フォームを作った初心者です。教えてください。 TextBox1　お客様番号 TextBox２　お客様氏名 TextBox3　住所 TextBox1にお客様番号を入れると別シートのデータから ”TextBox２　お客様氏名”と ”TextBox3　住所”が反映されるような設定にしたいです。また、お客様番号を入れて修正ボタンを押すと入力された内容が表示され修正が出来る設定にしたいです。登録ボタンへのコードは下記の内容になります。 Private Sub CommandButton1_Click() '登録ボタンをクリックしたときの処理 Dim LastRow As Long Dim MyOpt As String Dim i As Long 'ユーザーフォームの内容をExcelに転記 With Worksheets("接点記録") '最終行にプラス1 LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1 .Cells(LastRow, 2).Value = Me.TextBox1.Text　　 .Cells(LastRow, 3).Value = Me.TextBox2.Text .Cells(LastRow, 4).Value = Me.TextBox3.Text .Cells(LastRow, 5).Value = Me.TextBox4.Text .Cells(LastRow, 6).Value = Me.ComboBox1.Text .Cells(LastRow, 7).Value = Me.TextBox6.Text .Cells(LastRow, 8).Value = Me.TextBox7.Text .Cells(LastRow, 9).Value = Me.TextBox8.Text .Cells(LastRow, 10).Value = Me.TextBox9.Text TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" ComboBox1.Value = "" TextBox6.Value = "" TextBox7.Value = "" TextBox8.Value = "" TextBox9.Value = "" End With End Sub ご教示よろしくお願いいたします。

質問日時: 2023/11/03 08:46 質問者: yuki005

ベストアンサー

10

0
VBAでセル検索から対象行のセルをコピーする方法を教えてください。 B列に日付、C列からF列に数式が

VBAでセル検索から対象行のセルをコピーする方法を教えてください。 B列に日付、C列からF列に数式が入っています例) B列 10月1日 10月2日 10月3日 10月4日 C列空白空白数式A 数式B D列空白空白数式AA 数式BB E列・・以上の内容で B列から日付を検索(10月3日)し対象行のCからF列を選択してコピー、同一箇所に値貼り付けといったVBAはどのように書けばよろしいか教えて下さい。わかりづらくて申し訳ございません。

質問日時: 2023/11/02 10:54 質問者: ペイす

ベストアンサー

3

0
excel 数値を入力し自動で他のセルの数値を移動させる方法

画像で説明すると A2に数字を新しく入力すると自動でC2に800の数字が移動して、 D2に700が移動、E2に600が移動、F2に500が移動、G2に400が移動、H2に300が移動、I2に200が移動、J2に100が移動になって、 J2に入っていた10は自動で消えるようにするシートモジュールを教えてほしいです。ちなみにB3に入れた数字はC2に移動になってと下のところも同じくしたいのですが可能でしょうか？よろしくお願いいたします。

質問日時: 2023/10/31 17:16 質問者: msl.397

解決済

1

0
VBEを開くのにコマンド名が「Visual Basic」な理由はなぜ？

VBEについての質問です。 ExcelでVBAを記述する時に，VBEを開くと思いますが，Excelの開発タブから「Visual Basic」というコマンドをクリックすると思いますが VBEを開くのに，なぜコマンドの名称は「Visual Basic」なのでしょうか？

質問日時: 2023/10/31 17:07 質問者: kirakira_star_

解決済

3

0
Excelの各シートを色ごとで分類して値転記するマクロの作り方を教えて下さい。

Excel上に、赤・青・黄と３色に分類されたシートがあったとして、それぞれの色のシートの一つを値入力や変更したら、同色の他シートも全てそれに反映されるようにすることはできますでしょうか？例えば、添付画像の[Red1]シートを変更したら[Red2]シート・[Red3]シートも同じ値に変更され、同様に[Blue1]シートを変更したら[Blue2]シート・[Blue3]シートも、[Yellow1]シートを変更したら[Yellow2]シート・[Yellow3]シートも変更されるようにしたいです。お詳しい方、どうかご教示願います。

質問日時: 2023/10/31 12:19 質問者: take_goma

ベストアンサー

2

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

下記のマクロを実行すると解凍ソフト「Lhaplus」を使用して圧縮ファイルを解凍できます。このマクロを利用してWindows10の標準装備の解凍（ZIP形式）出来る方法を教えてください。宜しくお願い致します。マクロ Sub 解凍() On Error Resume Next Dim wsh As Object Dim Lhaplus実行ファイル As String Dim 圧縮データフォルダ As String Dim 解凍先フォルダ As String Set wsh = CreateObject("WScript.Shell") Lhaplus実行ファイル = "C:\Program Files (x86)\Lhaplus\Lhaplus.exe" 圧縮データフォルダ = ThisWorkbook.Path '①' 解凍先フォルダ = ThisWorkbook.Path wsh.Run Chr(34) & Lhaplus実行ファイル & Chr(34) & " /o:" & Chr(34) & 解凍先フォルダ & Chr(34) & " " & Chr(34) & 圧縮データフォルダ & Chr(34), , True Set wsh = Nothing MsgBox "全て解凍されました" End Sub 以上です。宜しくお願い致します。

質問日時: 2023/10/31 08:47 質問者: エクセル小僧

ベストアンサー

2

0
Excel マクロについて

Excelのマクロで10個のセルの合計値が初めて200を超えたところに←を示すプログラムを作れ。また、10個のセルを合計しても200を越えない時は最後の行に合計値を表示せよ。この問題でこの下の日本語の所を式に直すとどうなりますか？教えてくださいm(_ _)m 全く分からなくて、、、 Dim i As Long Dim total As Long i=1 While 合計が200を超えていないかつ 11行目まで達していない iの行をtotalに足す iを1増やす Wend if 合計が200を超えている Then i行に"←" Else i行に合計値を入力 End If End Sub

質問日時: 2023/10/30 23:54 質問者: ぽんまめ

解決済

3

0
ExcelVBAコードについて

=COUNTIF(祝日管理!$E$2:$L$25, $A6) 上記のような条件付き書式が設定してあります。祭日で稼働日があると塗りつぶしなしをしたいと思い、VBAコードで Sub 塗りつぶし削除マクロ() Dim rng As Range On Error Resume Next Set rng = Selection.SpecialCells(xlCellTypeConstants, xlCellTypeFormulas) On Error GoTo 0 If Not rng Is Nothing Then ' 選択したセルに条件付き書式が適用されている場合、塗りつぶしを削除する rng.Interior.ColorIndex = xlNone End If End Sub を入れましたが、実行しても塗りつぶしなしにならないのですが、何が原因でしょうか？教えてください。お願いします。

質問日時: 2023/10/28 16:54 質問者: tttaaa7

ベストアンサー

5

0
vab パソコンが変わってPageSetupが合わなくなりましたので教えてください

いつもお世話になります今まで社内でWindows10、Excel32bitVersionで統一されていましたが最近、相次いでWindows10-Windows11のExcel64bitVersionが導入され今までのPageSetupが合わなくなってきました記述は With ActiveSheet.PageSetup .TopMargin = Application.CentimetersToPoints(3) .RightMargin = Application.CentimetersToPoints(1) .LeftMargin = Application.CentimetersToPoints(2) .BottomMargin = Application.CentimetersToPoints(1) .Orientation = xlLandscape .Zoom = 60 End With ActiveWindow.View = xlPageBreakPreview ActiveWindow.Zoom = 75 になりますおそらくそれぞれのパソコンのセルスタイルに違いがあるのか？っと思っていますが合わせ方がよく分かりません「スタイルの結合」というのも聞きましたが、設定かVba上で元のステートメントのままでうまく行かないものかと悩んでいます。もし、分かりましたら教えてください以上、宜しくお願い申し上げます

質問日時: 2023/10/28 12:49 質問者: 公共ごま

ベストアンサー

1

0
VB.NetでMy.Settingsにセットされている値が空に表示さる

VB.NETでSettingsに3個の値をセットしています。そのうちの１個を確認のためにMsgBoxで表示しましたが、空になっています。何故でしょうか？ Settingsの内容は、プロジェクトのプロパティ、設定タブで確認しています。原因と対策方法をご教示頂きたくお願いします。

質問日時: 2023/10/27 14:01 質問者: isunsun

ベストアンサー

1

0
FileCopy時のエラー

FileCopy "D:\◆◆.exe", "C:\◆◆.exe"　で実行時エラー75　パス名が無効です。とエラーが発生します。 FileCopy "D:\◆◆.exe", "D:\Sample\◆◆.exe"ではエラーが発生しないのでたぶん\C:の部分が管理者権限の問題でエラーになっているのかなって思っています。このエラーを回避する方法をご教示いただきたくお願いいたします。

質問日時: 2023/10/27 06:24 質問者: 物好きじいちゃん

ベストアンサー

7

0
VB.NETでボタンのクリックイベントハンドラが2回実行される

VB.NETの下記のボタンのクリックイベントハンドラが２回実行されます。 Private Sub BtnSetting_Click(sender As Object, e As EventArgs) Handles BtnSetting.Click, BtnSetting.Click ：： End Sub 'Visual Studioでブレークポイントを設定 Visual Studio 2019で上記の「End Sub」ステートメントにブレークポイントを設定し実行したところ、１回目のブレークでステップインすると、上記の先頭ステートメントに制御が渡っています。この２回実行される原因と対策方法をご教示頂きたくお願いします。

質問日時: 2023/10/26 11:46 質問者: isunsun

ベストアンサー

1

0
chromedriverのDLについて

windows10(64bit)です。 VBAでSeleniumを利用しております。最新のchromedriverをDLするのに https://chromedriver.chromium.org/downloadsから DLしておりましたが現在のchromeのバージョン 118.0.5993.118と同様のバージョンがありませんでした。よく読むと「Chrome バージョン 115 以降を使用している場合は、Chrome for Testing の可用性ダッシュボードを参照してください。」とありましたのでこちらを確認しましたが、 118.0.5993.118とまったく同一のものがありませんでした。どのdriverをDLすればいいのでしょうか。

質問日時: 2023/10/26 05:32 質問者: 物好きじいちゃん

ベストアンサー

1

0
chatGPTで質問してみたエクセルのVBAについて

エクセルであるシート（A）の範囲（A1:D5）と範囲（E1:E5）を同時に別なシート　例えばシート（B）の同じ場所にコピーペーストしたい。　その時　別なシートへ移るときハイパーリンクで切り替えたいが　もともとの最初（A）のシートの右側　例えば　H1からH10までそれぞれのセルに移りたい各シート名を入れといて、あらかじめ　移りたいシートに移るハイパーリンクを作っておいた場合　そこのハイパーリンクされたセルをマウスでダブりクリックすると　自動的に移りたいシートに移り、最初のコピーしたシートと同じ位置　つまりはシートBの（A1:D5）と（E1:E5）にペーストされるようなVBAを教えてください　とchatGPTに質問した。帰ってきた答えは Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim ws As Worksheet Dim rngCopy1 As Range Dim rngCopy2 As Range Dim linkIndex As Long ' クリックされたハイパーリンクの位置を取得 linkIndex = Target.Range.Row - Me.Range("H1").Row + 1 ' シート名をH1からH10に対応するシート名に変更（必要に応じてカスタマイズ） Select Case linkIndex Case 1 To 10 Set ws = ThisWorkbook.Sheets("B") Case 11 To 20 Set ws = ThisWorkbook.Sheets("C") ' 必要に応じて他のケースを追加 End Select If Not ws Is Nothing Then ' シートAの範囲（A1:D5）と（E1:E5）をコピー If linkIndex <= 10 Then Set rngCopy1 = ThisWorkbook.Sheets("A").Range("A1:D5") Set rngCopy2 = ThisWorkbook.Sheets("A").Range("E1:E5") Else ' 例えば、範囲（E1:E5）もコピーしたい場合に対応 Set rngCopy1 = ThisWorkbook.Sheets("A").Range("A1:D5") Set rngCopy2 = ThisWorkbook.Sheets("A").Range("E1:E5") End If ' 対応するシートに移動して範囲をペースト ws.Activate ws.Range("A1").Resize(rngCopy1.Rows.Count, rngCopy1.Columns.Count).Value = rngCopy1.Value ws.Range("E1").Resize(rngCopy2.Rows.Count, rngCopy2.Columns.Count).Value = rngCopy2.Value End If End Sub と返答があったがAシート右に設定したBシートへのハイパーリンクにはペーストできるんだがAシート右に設定したCシートへのハイパーリンクセルをダブルクリックしてもBシートにいってしまってCシートにしはペーストできんのだが・・。

質問日時: 2023/10/24 07:37 質問者: norakurotodoroki

解決済

2

1
エクセルＶＢＡでの転記の方法について

転記が上手くいきません。ご教授いただきたくお願いいたします。 A列から、名前、記号、県名、金額　の表があるとして、名前”田中”の場合のみ、その列を右側セルに転記していくコードですが、添付画像の様に、同じ値（ループ最後の25行目の田中列）だけが貼りついてしまい上手くいきません。貼りつけたいのは、”田中、A、東京、100”、次の行に、”田中、C、神奈川、400”・・・と次行へ続けたいのですが、下記コードで何がいけないのかの理由と、できるだけ簡素に記述できるコード見本があればお願いいたします。 Sub 範囲3転記不具合() Dim rg As Range Dim ctR As Long Dim i As Long ctR = 2 For i = 2 To 25 If Cells(i, 1) = "田中" Then Set rg = Range(Cells(i, 1), Cells(i, 4)) rg.Copy Cells(ctR, 8).CurrentRegion ctR = ctR + 1 End If Next i End Sub

質問日時: 2023/10/22 19:14 質問者: お願いおせーてgoo

ベストアンサー

1

0
VB.NETでフォームアクティブのイベントハンドラが起動されない

VB.NETでForm1とForm2の2個のフォームがあります。そのForm1に対して、下記のアクティブイベントハンドラを作成しています。 Private Sub Form1_Activated(ByVal sender As Object, ByVal e As System.EventArgs) 　　　　　　　　　　　　　　　　oveHandler Me.Activated, AddressOf Form1_Activated : : End Sub しかし、Form1がアクティブになっても、そのイベントハンドラが起動しません。その原因と解決方法をご教示頂きたくお願いします。

質問日時: 2023/10/21 20:42 質問者: isunsun

ベストアンサー

1

0
Range.RemoveDuplicates メソッド

Excelの Range.RemoveDuplicates メソッドの Columns オプションの指定方法について、ご相談させてください。次の構文は、正しく処理できます。 ActiveSheet.Range("$A$1:$C$10").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes Columns オプションを動的に変更したく、次のように書き換えたのですが「プロシジャの呼出、または引数が不正です」となり、正しく処理されません。 Dim ary As Variant ary = Array(1, 2, 3) ActiveSheet.Range("$A$1:$C$10").RemoveDuplicates Columns:=ary, Header:=xlYes 正しく動作させるためには、どのように指定したら良いでしょうか。

質問日時: 2023/10/21 13:50 質問者: ママチャリ

ベストアンサー

1

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

下記のマクロを実行すると指定フォルダ内にワイルドカードで指定したフォルダの有無を検索し、メッセージが表示されます。このマクロをワイルドカードの数字の部分を例えば「12345678-6_」マクロを設定しているブックのシート名「番号」のセル値「C1：C6」に記載のある番号に変更して該当フォルダの有無を検索できるように変更する方法を教えてください。該当フォルダが複数あり場合は、メッセージボックスにその旨を表示出来るようにしたいのですが、よろしくお願いいたします。一つの例ですが画像のパターンですとメッセージボックスに「12345678-6_北海　太郎」と「123456789-1_北海　花子」の2つを表示です。マクロ Sub フォルダ検索() Dim 検索フォルダパス As String 検索フォルダパス = "C:\Users\160931\Desktop\10月16日\テスト" Dim 該当フォルダパス As String Dim dir結果値 As String dir結果値 = Dir(検索フォルダパス & "\12345678-6_*", vbDirectory) Do While dir結果値 <> "" Dim dir結果パス As String dir結果パス = 検索フォルダパス & "\" & dir結果値 If GetAttr(dir結果パス) And vbDirectory Then 該当フォルダパス = dir結果パス Exit Do End If dir結果値 = Dir() Loop If 該当フォルダパス <> "" Then MsgBox "該当フォルダのパス：" & 該当フォルダパス End If End Sub 以上となります。よろしくお願いいたします。

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

ベストアンサー

2

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

下記のマクロを設定しております。マクロを実行するとダイアログが表示されて、選択したフォルダ内に「検査時必要図書（正本）」がコピー出来るように設定しておりますが。マクロを実行しても、指定フォルダがコピーされません。この問題の解決方法を教えてください。よろしくお願いいたします。マクロ Sub フォルダコピー() Dim Dst As Variant With Application.FileDialog(msoFileDialogFolderPicker) If .Show = False Then Exit Sub Dst = .SelectedItems(1) End With Dim FSO As Object Dim Adr As String Set FSO = CreateObject("Scripting.FileSystemObject") Adr = ThisWorkbook.Path FSO.CopyFolder Adr & "\検査時必要図書（正本）", Dst End Sub

質問日時: 2023/10/19 09:27 質問者: エクセル小僧

ベストアンサー

1

0
マクロの修正方法の質問です。

添付写真のように、B列にフィルターをかけて、みかんだけのフィルターで印刷りんごだけのフィルターで印刷以下繰り返しと、フィルター上で選べるものを全て自動で印刷するようなマクロの作り方を教えていただきました。このB列指定のフィルターを C列のフィルターに変更して、長野だけのフィルターで印刷山梨だけのフィルターで印刷以下繰り返しと、するにはどこを直せばよろしいでしょうか？数百件あるので、教えていただけると助かります。どうぞ宜しくお願い致します。マクロは以下です。 Sub PrintFilteredData() Dim ws As Worksheet Dim rng As Range Dim cell As Range Dim filterRange As Range Dim uniqueItems As Collection Dim item As Variant Set ws = ThisWorkbook.Sheets("a") Set rng = ws.Range("A1").CurrentRegion Set filterRange = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count) Set uniqueItems = New Collection On Error Resume Next For Each cell In filterRange.Columns(2).Cells If cell.Value <> "" Then uniqueItems.Add cell.Value, CStr(cell.Value) End If Next cell On Error GoTo 0 For Each item In uniqueItems ws.AutoFilterMode = False filterRange.AutoFilter Field:=2, Criteria1:=item ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ws.AutoFilterMode = False Next item End Sub

質問日時: 2023/10/19 09:11 質問者: asdfxz

ベストアンサー

1

1
リストボックス複数選択抽出方法

いつもお世話になっております下記の部分を複数選択したいのですがどうしたよろしいでしょうか If r.Value = ListBox1.List(ListBox1.ListIndex) Then A列　担当Ｂ列　名前Ｃ列　性別 Private Sub UserForm_initialize() With ListBox1 .AddItem "工藤" .AddItem "加藤" .AddItem "遠藤" .AddItem "佐藤" .Font.Size = 14 .MultiSelect = fmMultiSelectMulti End With End Sub Private Sub CommandButton1_Click() Dim dic As Object Dim r As Range, rr As Range Dim key1, key2, i As Integer Set dic = CreateObject("Scripting.Dictionary") For Each r In Range("A2", Cells(Rows.Count, "A").End(xlUp)) If r.Value = ListBox1.List(ListBox1.ListIndex) Then If Not dic.exists(r.Value) Then dic.Add r.Value, _ CreateObject("Scripting.Dictionary") If Not dic(r.Value).exists(r.Offset(, 1).Value) Then _ dic(r.Value).Add r.Offset(, 1).Value, _ CreateObject("System.Collections.ArrayList") dic(r.Value)(r.Offset(, 1).Value).Add (r.Offset(, 2).Value) End If Next Set rr = Range("F2") Range("F:H").Clear For Each key1 In dic.keys rr.Value = key1 For Each key2 In dic(key1).keys Set rr = rr.Offset(1) rr.Offset(, 1).Value = key2 Set rr = rr.Offset(1) For i = 0 To dic(key1)(key2).Count - 1 rr.Offset(i, 2).Value = dic(key1)(key2)(i) Next Set rr = rr.Offset(dic(key1)(key2).Count - 1) Next Set rr = rr.Offset(1) Next Set dic = Nothing End Sub

質問日時: 2023/10/18 17:40 質問者: りんごプリン

ベストアンサー

6

1
VBA とびとびの列を結合させる

E列からI列に固定でなくデータが入っています。 VBAで各行ごとに、データが入っているとびとびのセルを J列のように結合させ表示したいのですがうまく動きません。構文は以下のようにしました。どこが間違っているか教えてください。 ※Ｇ列は使用しません。 For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 10) = WorksheetFunction.Concat(Range("H:I", "E:F")) Next どなたかお願いします。

質問日時: 2023/10/18 11:12 質問者: mihomiho34

解決済

1

0
VBAでC列が入力済みならそのままの値を表示し、空白ならA列の値で別ブックからVlookupしたい。

空白でない場合はネットでお見掛けするのですが、逆はどうしたら良いのか独学歴も浅く自力では最早解決出来そうになく、皆様の知恵をお借りしたいです。表のとある列に空白が所々空いており、それを埋める様な形をFor NextでWorksheetFunction.Vlookup を回して別ブックの表から値を持って来れたらと思っています。色々ネットを見ながら組んだのですが、最後のWorksheetFunctionの辺りでコードが上手くいきません。エラー回避を入れると最後までコードは動く様になるのですが、欲しい結果は得られません。イミディエイトを見ていると何やら転送先ファイルの範囲を上手く選択出来ていない様なのですが、どうしたら良いのか分からず自分ではお手上げです。どうか、ご教授お願いします。 Dim Nd As String Nd = Worksheets(“Meinmenu”).Range(“F19”).Value’年の値が入っています Dim Nd2 As String Nd2 = Worksheets(“Meinmenu”).Range(“E21”).Value’月の値が入っています Dim NewFN As String NewFN = (“転記先” & Nd & “年” & Nd2 & “月.xlsx”) Call コール用5‘転記先をアクティブ Worksheets(Nd & “年上期”).Select Dim i As Long For i = 13 To Cells(Rows.Count,3).End(xlUp).Row Dim x As Range x = Worksheets(Nd & “年上期”).Cells(i,”A”) If Cells(i,”C”) = “” Then Cells(i,”C”).Value _ = WorksheetFunction.Vlookup(x,Workbooks (“転記元.xlsm”).Worksheet(“転記用”).Range(“A2: 130”),2,False) End If Next i 宜しくお願いします。

質問日時: 2023/10/17 23:30 質問者: 洋司

ベストアンサー

2

0
環境依存文字？をEnumで定義したい

添付画像の環境委依存文字？（Unicode:9745）をEnum、もしくは、Const で定義したいのですが、VBE上で入力すると、"？" で表示されてしまいます。定義する方法は、ありますか？

質問日時: 2023/10/17 21:14 質問者: ママチャリ

ベストアンサー

2

0
vba userFormのSubを標準モジュールから呼び出す方法を教えてください

いつもお世話になります人の古いプログラムで標準モジュールから、ユーザフォームのSubroutineを呼び出しているのですが（Dialog Open）「オブジェクトが必要です」というエラーが出ます自分はこんな使い方をしたことがないのでよく分からないので教えてもらいたく投稿しました。（標準モジュール） '********************************** ' ﾌｧｲﾙﾃﾞｰﾀ入力 '********************************** Public Sub ①データ読込み(Optional IsMsg) With Application .SheetsInNewWorkbook = 3 End With ' UserForm1.cmdGetTabFile_Click ' Dialog Open If IsGetCancel = False Then Call GetPaste End If End Sub （UserForm1) Public Sub cmdGetTabFile_Click() Dim filename As String IsGetCancel = True With CommonDialog1 If strInTextDIR = "" Then strInTextDIR = CurDir End If Application.DefaultFilePath = strInTextDIR .InitDir = strInTextDIR .CancelError = False .filename = "" .Filter = "断面照査ﾃﾞｰﾀ(*.TXT)|*.TXT|全て|*.*" .ShowOpen If .filename = "" Then Exit Sub End If If Dir(.filename) = "" Then MsgBox "No FIle " & .filename Exit Sub End If TabFileNAME = .filename IsGetCancel = False End With strInTextDIR = getFilePath(TabFileNAME) End Sub 以上、よろしくお願い申し上げます

質問日時: 2023/10/17 15:06 質問者: 公共ごま

ベストアンサー

2

0
指定した条件で行セルを非表示にするVBAについて

いつもお世話になっております。この度、指定した条件でchat-GPTに助言を求めたところ、下記のVBAを提示していただいたのですが、重複している行セルが非表示になってくれず困っております。指定条件は、例えばD列に重複している文字列が入力されており、かつE列にPCの文字が入力されている場合、その重複している行セルを非表示にする処理を構築したいのですが ' D列の重複文字列とE列の含む"PC"をチェックし、行セルを非表示にする For i = 10 To lastRow Dim cellD As String Dim cellE As String cellD = ActiveSheet.Cells(i, 4).Value cellE = ActiveSheet.Cells(i, 5).Value If Not dictD.Exists(cellD) Then dictD(cellD) = 1 Else dictD(cellD) = dictD(cellD) + 1 End If If InStr(1, cellE, "PC", vbTextCompare) > 0 Then If Not dictE.Exists(cellD) Then dictE(cellD) = 1 Else dictE(cellD) = dictE(cellD) + 1 End If End If If dictD(cellD) > 1 And dictE(cellD) = 1 Then ActiveSheet.Rows(i).EntireRow.Hidden = True End If Next i こちらのVBAを実行したところ、PCが入力されている行セルだけが非表示となり、Surfaceが入力されている行セルは表示されたままとなります。この重複している行セルを非表示にすることは可能なのでしょうか？よろしくお願いいたします。

質問日時: 2023/10/17 03:09 質問者: pino382

ベストアンサー

17

1
VBA 何かしら文字が入っていたら

以下のルールで構文をかきたいのですが、あれこれやっても動きません。データはH1から固定数ではなくデータがはいってます。Ｈ列に何かしらの文字が入っていたらI列に「-」を返す空白の場合は空白で以上の構文をどなたかお願いします。

質問日時: 2023/10/16 15:43 質問者: mihomiho34

解決済

2

1
クリップボードに貼付している文字列が、マクロで別ブックへ転記すると、消えてしまう

現状（ケース１）ネット上にてホームページの文字列をコピー（ハンド作業） ⇒①マクロ実行（ブックAに文字列が貼付） ⇒②マクロ実行データの一部をブック２へ転記 ⇒クリップボードから、ネット上にてコピーしたホームページの文字列が消えている（ケース2）ネット上にてホームページの文字列をコピー（ハンド作業） ⇒①マクロ実行（ブックAに文字列が貼付） ⇒ブック１に貼付された、データをハンドでデリートする ⇒クリップボードから、コピーした文字列は消えない【改善したい事】ケース２のように、クリップボードからコピーした文字列が消えないようにしたい。そのまま残しておきたいです。ご存じの方、宜しくお願いします【①ブックAへデータを貼付するコード】 Sub 他のExcelへユニコード書式にて貼付_MSGBOXあり() Dim CB As Variant CB = Application.ClipboardFormats If CB(1) = True Then MsgBox "クリップボードにコピーされていません", vbOKOnly + vbCritical, "A部門" Exit Sub End If Worksheets("転記元").Range("A10").Select Worksheets("転記元").PasteSpecial Format:="Unicode テキスト" End Sub 【②ブック２へデータを貼付】 Sub 別ブックへ転記() Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow2 As Long Dim row2 As Long Dim i As Integer Set ws1 = Worksheets("転記元") For i = 1 To Workbooks.Count If Workbooks(i).Name = "book2.xlsx" Then '転記先のブック。 Set wb2 = Workbooks(i) End If Next Set ws2 = wb2.Worksheets("sheet1") '転記先シート maxrow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row '転記先のブックB列 row2 = maxrow2 + 1 ws2.Cells(row2, 2).Resize(1, 8).Value = ws1.Range("A1").Resize(1, 8).Value '転記元から転記先へ7セル分を転記.a1から７セル分。天気先。１列目から。 ws1.Range("I1").Copy ws2.Cells(row2, 10).Resize(1, 1) wb2.Save '転記先のブックを上書き End Sub

質問日時: 2023/10/15 13:36 質問者: aoyama-reiko

解決済

1

0
(マクロ）もともとある書式（文字列）をクリアーしないようにしたい。

以下のコードは、エクセル上にある文字をクリアーするコードです普通に動きます。しかし、書式で文字列にしておいたものも、（標準）に書式を戻してしまいます文字だけクリアーして、書式はクリアーしないように出来ないでしょうか？ご存じの方、教えて下さい（コード） Range("A10:XFD1048576").Clear

質問日時: 2023/10/14 17:57 質問者: aoyama-reiko

ベストアンサー

1

0
(マクロ）コピー貼付のマクロで、クリップボードに何も貼付ていな時の実行をエラーにしない為には

以下のコードは、エクセルのシートのA10に主にネットのブラウザの情報をコピーして貼付ます。ただし、何もコピーしていない状態で実行するとエラーになりますでバックは以下です。 ●クリップボードに何も張り付いていなくてもエラーにならない方法 ●クリップボードに何も張り付いていなければ、メッセージ（何も張り付いていません）と　表示されるにしたいです。ご存じの方、教えて下さい（デバック） Worksheets("転記元").PasteSpecial Format:="Unicode テキスト" 【コード】 Sub a10貼付() Worksheets("転記元").Range("A10").Select Worksheets("転記元").PasteSpecial Format:="Unicode テキスト" End Sub

質問日時: 2023/10/14 17:10 質問者: aoyama-reiko

解決済

1

0
【マクロ】複数シートを印刷する方法

標題の件、以下３つのシートを印刷するコードを教えて下さい出来る限り簡単なコードが良いです。ネットにて調べましたが、複雑なものが多かったです。ご存じのかた、宜しくお願いします Sheet1 Sheet2 Sheet３

質問日時: 2023/10/14 10:01 質問者: aoyama-reiko

ベストアンサー

2

0
VBA マウスクリックとキーボードの判定のGetAsyncKeyStateについて教えてください

いつもお世話になりますウェッブ調べて使ってみましたが、説明がよくわからず Debug.Print を入れてチェックしてみました Do If GetAsyncKeyState(vbKeyLButton) = 32768 Then '...マウス左クリックの判定 Debug.Print "check1", GetAsyncKeyState(vbKeyLButton) Exit Do ElseIf GetAsyncKeyState(vbKeyReturn) = 32768 Then '...エンターキーの判定 Debug.Print "check2", GetAsyncKeyState(vbKeyReturn) Exit Do ElseIf GetAsyncKeyState(vbKeyEscape) = 32768 Then '...エスケープキーの判定 Debug.Print "check3", GetAsyncKeyState(vbKeyEscape) GoTo ErrOut End If Loop 今、三つのKeyでチェcckしてみましたが押されたときはみなプラスの32768のようですがこれで良いのですか？ちょっと不安だったので投稿してみました押される前は"0"か"1"みたいですが以上、宜しくお願い致します

質問日時: 2023/10/11 18:33 質問者: 公共ごま

ベストアンサー

2

0
Windows 11 Pro での、VBAのCode書き換えで、１点お教え願います。

6年程前に、市販のBVA参考書をベースに、PCでアルバム閲覧Softを自作する折、ﾃﾞｼﾞｶﾒの***.JPGの撮影日時を読み込むVBA_codeに手こずり、この「教えてGoo」でいろいろヒントを頂いて、完成できました（多謝）。 **現在、当時のWindows8から、Windows11 Proに移行中で、一か所、VBA_Codeで苦戦中です。画像4枚を貼りました。VBA_UserForm1のListBox1で、写真リスト番号2389が、番号23と表示されて、下2桁の89が隠れてしまいます。一か所書き換えればと思いますが、どのCodeを書き換えれば良いか見当がつきません。 **** 何かヒントを頂ければ幸いです。**** まず、VBA_Codeを足ります。あと画像3枚を追加添付します。 ********** VBA_UserForm1、ListBox1 のCode ' *** UserForm1 code ' Universal Dim Dim Fname As String Dim RowPos As Integer Dim zycount As Integer Private Sub Frame1_Click() End Sub Private Sub Image1_Click() End Sub Private Sub TextBox8_Change() End Sub Private Sub UserForm_Initialize() Dim i As Integer Dim Str1 As String Dim Str2 As String ' RowPos as integer as Universal ' zycount As Integer as Universal Worksheets(1).Select RowPos = 11 zycount = 1 Do Str1 = Cells(RowPos, 3) ' PhotoName 日本語 Str2 = Cells(RowPos, 2) ' PhotoName カメラ連番FileName xxx.jpg ListBox1.AddItem (zycount) ListBox1.List(zycount - 1, 1) = (Str1) RowPos = RowPos + 1 zycount = zycount + 1 Loop While Str2 <> "" ' ListBox1.RemoveItem RowPos - 12 'setting Initial Photo=The last On Error GoTo ErrorHandler ListBox1.Selected(RowPos - 13) = True 'ListBox1_Clickと等価一番最後にセット ' ListBox1.Selected(0) = True 'ListBox1_Clickと等価一番最初にセット UserForm1.Image1.PictureSizeMode = fmPictureSizeModeZoom Exit Sub ErrorHandler: MsgBox "表示する写真が一枚も登録されていません" & vbCr & vbCr & _ "「写真追加作業」で、写真を登録してから、写真閲覧ボタンをクリックしてください。" End End Sub Private Sub CommandButton1_Click() Unload Me UserForm2.Show End End Sub Private Sub ListBox1_Click() Dim myPath As String ' Dim Fname As String as Universal ' RowPos as integer as Universal ' zycount As Integer as Universal RowPos = ListBox1.ListIndex + 11 With Worksheets(1) myPath = .Cells(RowPos, 1) ' myPath = "C:\Users\ZY\Documents\柳澤写真\20xy年" Fname = .Cells(RowPos, 2) '写真番号 xxx.jpg File Name TextBox6.Value = .Cells(RowPos, 3) 'Photo Name TextBox3.Value = .Cells(RowPos, 4) 'Date TextBox4.Value = .Cells(RowPos, 5) 'Place TextBox5.Value = .Cells(RowPos, 6) 'Memo TextBox1.Value = .Cells(RowPos, 7) 'Camera TextBox2.Value = .Cells(RowPos, 8) 'Size TextBox8.Value = myPath & " \" & Fname 'Photo Address" End With Fname = myPath & "\" & Fname Image1.Picture = LoadPicture(Fname) '写真表示 End Sub Private Sub CommandButton2_Click() UserForm1.Image1.PictureSizeMode = fmPictureSizeModeClip Image1.Picture = LoadPicture(Fname) End Sub Private Sub CommandButton3_Click() UserForm1.Image1.PictureSizeMode = fmPictureSizeModeZoom Image1.Picture = LoadPicture(Fname) End Sub Private Sub TextBox1_Change() Worksheets(1).Cells(RowPos, 7) = TextBox1.Value 'カメラ End Sub Private Sub TextBox2_Change() Worksheets(1).Cells(RowPos, 8) = TextBox2.Value 'サイズ KB End Sub Private Sub TextBox3_Change() Worksheets(1).Cells(RowPos, 4) = TextBox3.Value '更新・撮影日時 End Sub Private Sub TextBox4_Change() Worksheets(1).Cells(RowPos, 5) = TextBox4.Value '撮影場所 End Sub Private Sub TextBox5_Change() Worksheets(1).Cells(RowPos, 6) = TextBox5.Value 'メモ End Sub Private Sub TextBox6_Change() Worksheets(1).Cells(RowPos, 3) = TextBox6.Value 'Revised Photo Name ListBox1.List(ListBox1.ListIndex, 1) = TextBox6.Value 'Revised Photo Name End Sub Private Sub ExitBtn_Click() Unload Me Application.Quit '/// AutoOpen.Show End End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then Unload Me Application.Quit End End If End Sub ***以上 2023/10/11 PLSヘルプme

質問日時: 2023/10/11 01:12 質問者: PLSヘルプme

ベストアンサー

2

1
csvファイルを列数ごとに分割するExcelマクロが書けずに困っています

csvファイルを列数ごとに分割するExcelマクロが書けずに困っています。これがないため作業が遅くなり困っています。横に長い（列数が多い）csvファイルを指定した列数ごとに分割して複数のcsvファイルに分けたいのですができません。行数ごとに分割して複数のcsvファイルに分けるExcelマクロは調べると複数出てくるのですが... 何かいい方法はないでしょうか？以下がコードです。 https://yu-syan.sakura.ne.jp/?p=87 たぶんLine Input # ステートメントで行数ごとに読込している部分を列数ごとに読込すればできると思うのですがその動作をするステートメントが無いため困っています。 http://officetanaka.net/excel/vba/statement/LineInput.htm 以下がcsvファイルです。 https://drive.google.com/file/d/1W0O4R10ibNVRnzDzeZ9AKSRT9gueS3GZ/view?usp=drive_link #VBA #Excel #マクロ #csv #データ処理

質問日時: 2023/10/09 12:12 質問者: ねぐせ

解決済

8

2
Excel VBAにて、2GB超の点群データ(CSVファイル,改行コードLF)を高速で解析したい。

点群データファイルより、任意の範囲の点データを取得し、平均標高を求めるマクロを「Excel VBA」で作りました。ただ、今回点群データファイル(CSVファイル)の改行コードが「X,Y,Z(CR+LF)」から「X,Y,Z(LF)」に仕様変更になったため、 Line Inputステートメントで読み込めなくなりました。 Getステートメントで1バイトずつ読み込むように改変しましたが今度は、点群データファイルの2GB制限により「アドレスが不正です」のエラーメッセージが出てしまい、処理が中断してしまいます。 (なお、今回の解析要な点群データのファイルサイズは17GB超です。) ' バッファの初期化 strBuf = "" Open "点群.csv" For Binary Access Read As #1 Do Until EOF(1) 　　Get #1, , bytCode ' ここで中断　　If bytCode <> 10 Then 　　　　' LF以外の場合　　　　strBuf = strBuf & Chr(bytCode) 　　Else 　　　　' LFの場合　　　　varBuf = Split(strBuf, ",") 　　　　' 　　　　.... (解析処理) 　　　　' バッファの初期化　　　　strBuf = "" 　　End If Loop Close #1 ' .... (解析結果を出力) まとめると、以下の条件のファイルを高速に読み込みたいです。　1. 2GBを超えるCSVファイル　2. 改行コードがLFのみサンプルプログラムを教えていただければありがたいです。よろしくお願いいたします。

質問日時: 2023/10/07 11:01 質問者: セバスチャンだよ

解決済

2

0
マクロVBAについてご教授いただけましたらと存じます。

教えていただければありがたいです。購入品表、使用品表にはともに品名、箱数、個包装のそれぞれが記入されております。購入表側には同一品名のものもありますが、個数等が異なります。費用品表には品名と使用した数を記入しております。教えていただきたい内容ですが、最終的な在庫数を知るためのマクロVBAについてのご相談です。順番は良いのですが②購入品表の整理（重複品名は削除し、個数を和算）③品名が同じものを同じ行に並べ購入品表から使用品表の数を引き算し、在庫表を完成させる④。このようなことは可能でしょうか？ ..................D......E.........F..........G.......H.........I.... ........1..............購入品.....................使用品........... ........2.......品名..箱数...個包装.....品名....箱数....個包装 ①.....3.......あい....1.........6........かい.................5... ........4.......かい..............10.......あい.................1... ........5.......あい....2.........2................................... ........6.......さい....1.............................................. ........7.......たい....5..........5.................................. ..................D......E.........F..........G.......H.........I.... ........1..............購入品.....................使用品........... ........2.......品名..箱数...個包装.....品名....箱数....個包装 ②.....3.......あい....3.........8........かい.................5... ........4.......かい..............10.......あい.................1... ........5.......さい....1.............................................. ........6.......たい....5.........5................................. ..................D......E.........F..........G.......H.........I.... ........1..............購入品.....................使用品........... ........2.......品名..箱数...個包装.....品名....箱数....個包装 ③.....3.......あい....3.........8........あい.................1... ........4.......かい..............10.......かい.................5... ........5.......さい....1.............................................. ........6.......たい....5.........5................................. ..................A......B.........C......... ........1..............在庫.................. ........2.......品名..箱数...個包装..... ④.....3.......あい....3.........7........ ........4.......かい...............5....... ........5.......さい....1.................... ........6.......たい....5.........5..........

質問日時: 2023/10/04 12:37 質問者: mokatsu

ベストアンサー

5

1
VBA 同じ名前のオブジェクトを選択したいのですが

オブジェクトが沢山あり、選択したいオブジェクトには同一の名前を付けてあります。 For Each を使うのだと思いますが、同一の名前のオブジェクトを全て選択状態にしたいのですが、どのようにすれば良いでしょうか。

質問日時: 2023/10/03 22:38 質問者: payphone

ベストアンサー

1

0
一つのフォルダーに50個のエクセルファイルがあります。各ファイルにはAとBのシートがあります。 5

一つのフォルダーに50個のエクセルファイルがあります。各ファイルにはAとBのシートがあります。 50個エクセルファイルのBのシートをCのシートの内容に一括で変更し、シート名はBのままにします。 VBAをはじめて使おうと試みています。 cシートは別のフォルダに保存しています。下記のコードでいいでしょうか？また保存するときはどうしたらいいのでしょうか？ VBAはどのエクセルファイルからコードを入力すればいいでしょうか？50個のファイルのうちの一つですか？ Sub ReplaceBSheetContentWithTemplateC() ' 必要な情報の設定 Dim FolderPath As String: FolderPath = "C:\YourFolderPath\"' あなたのフォルダのパスを変更してください Dim TemplatePath As String: TemplatePath = "C:\YourTemplatePath\TemplateFile.xlsx"' テンプレートファイルのパスを変更してください ' 他の変数の定義 Dim FileName As String Dim TemplateWb As Workbook Dim TargetWb As Workbook ' テンプレートファイルを開く Set TemplateWb = Workbooks.Open(TemplatePath) ' フォルダ内の最初のExcelファイルの名前を取得 FileName = Dir(FolderPath &"*.xls*") ' フォルダ内のすべてのExcelファイルをループで処理 Do While FileName <>""' ファイルを開く Set TargetWb = Workbooks.Open(FolderPath &FileName) ' Bシートの内容をクリア TargetWb.Sheets("B").Cells.Clear ' テンプレートのCシートの内容をBシートにコピー TemplateWb.Sheets("C").Cells.Copy Destination:=TargetWb.Sheets("B").Cells ' ファイルを保存して閉じる TargetWb.Close SaveChanges:=True ' 次のファイルの名前を取得 FileName = Dir Loop ' テンプレートファイルを閉じる TemplateWb.Close SaveChanges:=False End Sub

質問日時: 2023/10/03 16:25 質問者: hanayawarakashi

解決済

2

0
VisualStudio2022をマクロみたいに自動プログラムを作成する方法を教えてください。

VisualStudio2022をマクロみたいに自動プログラムを作成する方法を教えてください。

質問日時: 2023/10/02 20:05 質問者: あっきー126

解決済

2

0
自動VBAマクロって会社の中で禁止なんですか?

自動VBAマクロって会社の中で禁止なんですか?

質問日時: 2023/09/29 20:03 質問者: あっきー126

解決済

2

0
Excelマクロで空白セルの大小比較処理について

Excelで対象のシートを選択した際に、前週の商品単価からプラスマイナス10円以上超過した場合にてメッセージを表示させるマクロを作りたく以下のVBAコードを書いてみましたが、添付画像のように空白セル(B6)があるとメッセージが表示されてしまいます。空白セルを無視することはできないでしょうか？ Private Sub Worksheet_Activate() If Range("B3") <= Range("B2") - 10 Or Range("B3") >= Range("B2") + 10 Or _ Range("B4") <= Range("B3") - 10 Or Range("B4") >= Range("B3") + 10 Or _ Range("B5") <= Range("B4") - 10 Or Range("B5") >= Range("B4") + 10 Or _ Range("B6") <= Range("B5") - 10 Or Range("B6") >= Range("B5") + 10 Then MsgBox ("±10円をオーバーしています！") End If End Sub

質問日時: 2023/09/29 10:24 質問者: take_goma

ベストアンサー

1

0
エクセルマクロで出力行の増やし方がわかりません。

エクセルマクロで残業時間入力シートを作成しています。 1シートあたり8日分しか記載できないため、9日目以降は2枚目に書く必要があります。下記のコードでは、1枚目が8日分（8行）埋まれば2枚目に移行し、2枚目も8日分（8行）埋まれば3枚目に移行するように組んでいるつもりです。問題は、1枚目は上から順に8日分記載してくれるのですが、2枚目では記載する行が増えずに同じ行の上に上書きしてしまいます。つまり2枚目が埋まらないのです。下の方の「’出力行を増やす」が2枚目ではどうもうまく機能していないようです。どのように改善すればよろしいでしょうか？ご指導のほどよろしくお願いします。 Sub 出力するコード() Dim wsInput As Worksheet Dim wsOutput As Worksheet Dim wsOutput2 As Worksheet Dim wsOutput3 As Worksheet Dim LastRow As Long Dim DateRange As Range Dim WeekdayRange As Range Dim AbsenceRange As Range Dim WorkTypeRange As Range Dim DepartureTimeRange As Range Dim OutputRow As Long ' 入力シートと出力シートを設定 Set wsInput = ThisWorkbook.Sheets("入力シート") Set wsOutput = ThisWorkbook.Sheets("出力シート") Set wsOutput2 = ThisWorkbook.Sheets("出力シート2") Set wsOutput3 = ThisWorkbook.Sheets("出力シート3") ' 最終行を取得（B列のデータが入力されている最終行を基準にする） LastRow = wsInput.Cells(wsInput.Rows.Count, "B").End(xlUp).Row ' 列の範囲を設定 Set DateRange = wsInput.Range("B9:B" & LastRow) Set WeekdayRange = wsInput.Range("C9:C" & LastRow) Set AbsenceRange = wsInput.Range("E9:E" & LastRow) Set WorkTypeRange = wsInput.Range("F9:F" & LastRow) Set DepartureTimeRange = wsInput.Range("I9:I" & LastRow) ' 出力行の初期化 OutputRow = 1 'シート2の出力初期化 Dim OutputRowSheet2 As Long OutputRowSheet2 = 1 ' シート3の出力行初期化 Dim OutputRowSheet3 As Long OutputRowSheet3 = 1 ' 行ごとにデータを検査 Dim i As Long For i = 1 To LastRow - 8 ' ヘッダー行を除外するために -8 する If (AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "日勤" And DepartureTimeRange.Cells(i).Value > TimeValue("17:15")) Or _ (AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "6:45早出" And DepartureTimeRange.Cells(i).Value > TimeValue("15:30")) Or _ (AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "11時遅出" And DepartureTimeRange.Cells(i).Value > TimeValue("19:45")) Then If OutputRow <= 8 Then ' 出力シート1に記載 wsOutput.Cells(OutputRow + 6, 1).Value = DateRange.Cells(i).Value ' 日付 wsOutput.Cells(OutputRow + 6, 2).Value = WeekdayRange.Cells(i).Value ' 曜日 wsOutput.Cells(OutputRow + 6, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻 Else If OutputRowSheet2 <= 8 Then ' 出力シート2に記載 wsOutput2.Cells(OutputRowSheet2 + 6, 1).Value = DateRange.Cells(i).Value ' 日付 wsOutput2.Cells(OutputRowSheet2 + 6, 2).Value = WeekdayRange.Cells(i).Value ' 曜日 wsOutput2.Cells(OutputRowSheet2 + 6, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻 Else ' 出力シート3に記載 wsOutput3.Cells(OutputRowSheet3 + 7, 1).Value = DateRange.Cells(i).Value ' 日付 wsOutput3.Cells(OutputRowSheet3 + 7, 2).Value = WeekdayRange.Cells(i).Value ' 曜日 wsOutput3.Cells(OutputRowSheet3 + 7, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻 End If OutputRowSheet2 = OutputRowSheet + 1 End If ' 出力行を増やす OutputRow = OutputRow + 1 OutputRowSheet2 = OutputRowSheet + 1 End If Next i

質問日時: 2023/09/28 23:40 質問者: かいかいまる

ベストアンサー

4

1
メール送信をVB.NET化するにはどうしたらよいでしょうか？

メール送信をVB.NET化するにはどうしたらよいでしょうか？

質問日時: 2023/09/28 20:26 質問者: あっきー126

解決済

1

0
【VBA】マクロの入ったファイルと同じフォルダに，出力したファイルを保存するコードについて

Excel（office365）を使っている者です。 Excel VBAで，PDFでファイルを出力して，そのファイルを当該マクロの入ったファイルと同じ場所に保存したく，以下のようなコードを書いたのですが，一つ上の階層のフォルダに保存（作成）されてしまいます。どうすれば，同じ階層のフォルダに保存できるようになるのか，ご教示願います。よろしくお願いいたします。 -----------------------------------------------------（関連する部分のみ抜粋） Dim myfolder As String myfolder = ThisWorkbook.Path l = Worksheets("評価").Range("N5").Value & "・" & Worksheets("評価").Range("N4").Value ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=myfolder & l & ".pdf", OpenAfterPublish:=True, IgnorePrintAreas:=False ------------------------------------------------------

質問日時: 2023/09/28 13:36 質問者: qazxcvfr4

ベストアンサー

3

0
エクセル VBA 他シートの行を選択して，転記する。

お世話になります。いつも助けられてます。エクセルVBAの質問です。個別のコーディングはできるのですが，表題の件について，アドバイスいただければと思います。やりたいことは，１．ThsisWorkBookから他ブックを開く ↓ ２．開いたブックをみながら特定の行を選ぶ（←　→キーか，マウスを使う） ↓ ３．選んだ行をThsisWorkBooに転記するのようなことです。今までは，２の部分がは，あらかじめ読む行をテキストボックス等から取得していましたが，視覚的に分かりやすくしたいので，２の部分をいれたいと考えています。キー入力の方法とうは，分かるのですが，流れとしてどんな手順を踏めばいいのか，また，どのようなイベントを使用すればいいのか，アドバイスいただければありがたいです。

質問日時: 2023/09/27 22:46 質問者: mabo52

ベストアンサー

3

0
【補足欄が足りなかったため、こちらで再質問させていただきます。】 Excelの転記マクロについて、教

【補足欄が足りなかったため、こちらで再質問させていただきます。】 Excelの転記マクロについて、教えてください。 AAAAというExcelのデータがあり A列に、支店名コード（４桁）があり、支店ごとの情報がＸ列まで入っています。 ①AAAA.exｃｅｌ　（データはＡ列からＸ列まで）支店名　　売上　　　最終値引き・・・・・ 0001 50000 4500 0002 60000 12000 　・　・　このデータを支店名でフィルターをかけて、支店別のExcelに見出しなし、かつ支店名を除いたデータを転記したいと考えています。例えばですが・・[0001支店.excel]　にデータを貼り付けたいのですが支店別のExcelには、A-C列に別の情報が入っていて、 D列から、　売上　最終値引き・・・　の見出しがあるので D列（２行目）から、フィルターをかけた可視セルの情報を値貼付けしたいです。（Ａ列の支店名は不要）どうしても支店名がコピーされてしまうので、困っています。どなたか教えていただけると助かります！マクロは、下記の通りです。 Sub TEST() Dim Wb1 As Workbook Dim Wb2 As Workbook '現在開いているファイルを変数格納 Set Wb1 = ActiveWorkbook '別ファイルを開く Workbooks.Open "D:\Users\△△\0001支店.xlsx" Set Wb2 = ActiveWorkbook 'フィルターでデータ抽出 Wb1.Sheets("S1").Range("A1").CurrentRegion.AutoFilter _ Field:=1, _ Criteria1:="0001" If WorksheetFunction.Subtotal(3, Range("A:A")) > 1 Then 'フィルター抽出結果を別ファイルへ転記 With Wb1.Sheets("S1").Range("B1:X1").CurrentRegion .Resize(.Rows.Count - 1).Offset(1, 0).Copy Wb2.Sheets("TEST").Range("D7").PasteSpecial Paste:=xlPasteValues End With End If 'オートフィルタを解除 Range("A1").AutoFilter End Sub

質問日時: 2023/09/27 08:51 質問者: kappasan4646

ベストアンサー

4

1
【VBA】飛び飛びの3セルに"完了"かもしくは"支援なし"の文字が入っていたら、計算を実行したい

VBA初心者です。初めて質問させて頂きます。 400行程度の業務管理表のマクロを作成しております。 1行につき1物件のデータですが、1物件につき3回の〆切日があります。その3回とも"完了"かもしくは"支援なし"になったら、それぞれの作業時間を合計するような感じにしたいです。（作業時間の方は、同じシート内の遠い場所にSplit関数で1セルずつ抽出しております。）以下のように考えてみたのですが、全く動作せず・・・検索や書籍にあたってもなかなか該当する内容に当たらず途方に暮れております・・・。何か原因はございますでしょうか。ご教示いただけますと幸いです。宜しくお願い致します。 Sub 複数のセルが終了か支援なしの時() Dim i, lRow As Long Dim rng As Range lRow = Cells(Rows.Count, "B").End(xlUp).Row For i = 6 To lRow Next Select Case Cells(i, 16).Value & Cells(i, 24).Value & Cells(i, 34).Value Case "終了", "支援なし" Set rng = Union(Range(Cells(i, 178), Cells(i, 192)), _ Range(Cells(i, 206), Cells(i, 220)), _ Range(Cells(i, 234), Cells(i, 248)), _ Range(Cells(i, 262), Cells(i, 276)), _ Range(Cells(290))) Cells(i, 43) = _ Application.WorksheetFunction.Sum(rng) Case Else '何も実行しない End Select End Sub

質問日時: 2023/09/26 04:21 質問者: のこのこさんぽ

解決済

2

0
select case について

いつもお世話になっております Range("C2:C4")に値を入力するとＣ6に合計がでます。 '①　　'②　　'③　の部分を一つにまとめることはできますでしょうか Private Sub Worksheet_Change(ByVal Target As Range) Dim Rngs As Range, Rng As Range Set Rng = Intersect(Target, Range("C2:C4")) If Rng Is Nothing Then Exit Sub For Each Rngs In Rng Select Case Rngs.Address(False, False) Case Is = "C2"　　　'① Range("C6").Value = WorksheetFunction.Sum(Range("C2:C4")) Case Is = "C3"　　　　　'② Range("C6").Value = WorksheetFunction.Sum(Range("C2:C4")) Case Is = "C4"　　　　'③ Range("C6").Value = WorksheetFunction.Sum(Range("C2:C4")) End Select Next

質問日時: 2023/09/24 23:14 質問者: りんごプリン

解決済

1

1
xlookup関数の引数を利用して検索元に移動するVBAコードについて

sheet2のa1:a10には支店番号、b1:b10には支店名のデータが入力されています。sheet1のa1セルに支店番号を入力するとxlookup関数を用いて支店名がsheet1のb1セルに表示されるようになっています。そのsheet1の支店名が表示されているセルをクリックするとsheet２の検索元のセルに移動するvbaコードを教えてください。 chatgptに聞いても作動できるコードにたどり着きませんでした。

質問日時: 2023/09/24 11:48 質問者: 003popo

ベストアンサー

6

0
VB.Netでファイル圧縮する方法は何ですか?

VB.Netでファイル圧縮する方法は何ですか?

質問日時: 2023/09/22 16:38 質問者: あっきー126

ベストアンサー

1

0

←前の結果
1
2
3
4
5
6
7
8
9
10
11
12
13
...
20
次の結果→

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

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

質問する（無料）

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

弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」

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

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

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

今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...