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

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

回答数

気になる

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

以下のコードは、エクセルのシートの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
VB.NETでVBスクリプトを作るにはどうしたらいいですか?

VB.NETでVBスクリプトを作るにはどうしたらいいですか?

質問日時: 2023/09/22 08:24 質問者: あっきー126

ベストアンサー

1

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

マクロコードがあります。このマクロをマクロ実行では無く、マクロを設定している作業ブックを開いたタイミングで実行出来るように VBAコードを「ThisWorkbook」に設定する方法を教えてください。詳しいコード共に親切に教えて頂ける方、宜しくお願い致します。マクロ Sub 番号コピー() With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then GetIDNuber (.SelectedItems(1)) End If End With End Sub Function GetIDNuber(s As String) As String Dim temp Dim IDNumber As String temp = Split(s, "\") temp = Split(temp(UBound(temp)), "_") SetClipBoard (temp(0)) End Function Sub SetClipBoard(s As String) Dim buf As String, buf2 As String, CB As Object Set CB = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") With CB .SetText s ''変数のデータをDataObjectに格納する .PutInClipboard ''DataObjectのデータをクリップボードに格納する .GetFromClipboard ''クリップボードからDataObjectにデータを取得する End With End Sub このマクロ実行すると第が開き、指定したフォルダ名の「_」から前の番号をコピーできるようになっております。宜しくお願い致します。

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

ベストアンサー

1

0
Excel VBA素人です。VBAで図形のセンタリング方法ご教示下さい

Excel　VBA素人です。VBAで図形をセンタリングする為のコードご存じの方教えてください。 C1:G8には文字（アルファベット）が入っています。文字を検索し「A」のみの中央に図形の「〇」（※緑色）を付けたく、以下のコードを作ってみましたが、添付の写真のように、セルの中央に「〇」が付きません。Forループを使わない場合は上手くいくのですが。（尚、図形削除のボタンは無視してください）図形を文字中央に移動するために必要なコード（Forループ内で）をご教示ください。以下現状のコードです。 Sub まる() Dim n As Integer Dim d As Integer s = 0 For d = 1 To 5 For n = 3 To 8 If Cells(d, n) = "A" Then ActiveSheet.Shapes("まる").Copy Cells(d, n).Select ActiveSheet.Paste End If Next n Next d End Sub 素人ですので丁寧なご指導をお願いいたします。

質問日時: 2023/09/19 10:39 質問者: さつまいも----------。

ベストアンサー

2

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

エクセルのマクロについて教えてください。印刷設定をマクロで設定することは可能でしょうか。マクロを実行して作業ブックの指定シートをページレイアウトが「2in1」「両面」に出来る方法があれば教えてください。指定シート名は「1号確認」「4号完了」の2つです。詳しいコード共に親切に教えて頂ける方、よろしくお願いします。

質問日時: 2023/09/15 09:38 質問者: エクセル小僧

ベストアンサー

1

0
Vba Cells.Findについて教えてください

いつもお世話になります今、ひとつのシートにユーザ定義関数が二つ有ってそれぞれの関数は定義されているセルの下に表を持っています Application.Volatileを使って自動計算をさせ Row0 = Application.ThisCell.Row sht.Cells(Row0, 1).Activate Call FindColumnWhole("周期", Row1, Col1) その関数以下の行から検索させていますがどうしても上の表の文字を検索してしまいます Afterが機能しないので困っていますもし分かりましたら教えてくださいなお、自動計算にはこんな定義もしています Dim targetCell As Range Set targetCell = Application.Caller Set sht = targetCell.Parent また、Findのサブルーチンは以下のようにしています Sub FindColumnWhole(ByVal SearchM As String, Findrow As Integer, Findcol As Integer) Dim FoundCell As Range, FirstCell As Range, Target As Range nError = True Set FoundCell = Cells.Find(what:=SearchM, After:=Cells(Row0, 1), LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False) If FoundCell Is Nothing Then 'MsgBox "検索文字（" + SearchM + "）が見つかりません" nError = False Exit Sub Else Set FirstCell = FoundCell Set Target = FoundCell Findrow = FoundCell.Row Findcol = FoundCell.Column End If End Sub いつもありがとうございますちょっと分かりづらい説明になってしまいましたがよろしくお願い申し上げます

質問日時: 2023/09/13 19:47 質問者: 公共ごま

ベストアンサー

1

0
xmlドキュメントから別拡張子で保存したい

★以下エラー箇所★にて、エラーが発生してしまい修正ができず困っています。エラー内容は、「実行時エラー1004,SaveAsメソッドは失敗しました'_Workbook'オブジェクト] ファイルの種類は、xmlドキュメント（エクセル状態） Private Sub ファイル名作成() Dim lastRow As Long Dim supplierNames As Object Dim supplierName As Variant ' データの最終行を取得 lastRow = Cells(Rows.Count, "B").End(xlUp).Row ' 仕入先名称を格納するコレクションを作成 Set supplierNames = CreateObject("Scripting.Dictionary") ' データの重複を排除してコレクションに追加 For i = 2 To lastRow ' ヘッダー行を除外 If supplierNames.Exists(Cells(i, "B").Value) = False Then supplierNames.Add Cells(i, "B").Value, 1 End If Next i ' コレクションの要素をファイル名として連結 For Each supplierName In supplierNames.Keys fileName = fileName & supplierName & "," Next supplierName ' ファイル名の最後のカンマを削除 fileName = Left(fileName, Len(fileName) - 1) ' ファイル名に使用できない文字を削除する fileName = ReplaceInvalidFileNameCharacters(fileName) ' ファイルを保存 ' On Error Resume Next ' ActiveWorkbook.SaveAs fileName:=ActiveWorkbook.Path & "\" & "単価変更リスト_" & Format(Date, "yyyymmdd") & "_" & fileName, _ ' FileFormat:=xlOpenXMLWorkbook ★以下エラー箇所★ ActiveWorkbook.SaveAs fileName:=ActiveWorkbook.Path & "" & "単価変更リスト_" & Format(Date, "yyyymmdd") & "_" & fileName & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook ' If Err.Number > 0 Then ' MsgBox ("ﾌｧｲﾙを選択してください") ' End ' End If '単価ﾘｽﾄブックアクティブ用 priceListBook = ActiveWorkbook.Name End Sub

質問日時: 2023/09/12 11:08 質問者: tanukiin

解決済

4

0
wordのマクロで思うように行きません(ファイル削除ができない)

wordの差し込み印刷で、PDFファイルで保存するマクロを作成したのですが、保存先の「出力」フォルダーに、PDFファイルとワードファイルが作成されます。不要なワードファイルを削除しようと、 Kill myMainDoc.Path & "\" & "出力\" & myFileName & ".docx" を入れているのですが、ワードファイルが削除できません。なぜでしょうか? ------------------ Sub 差し込み印刷_レコード毎に別ファイルで保存() Dim myMainDoc As Document: Set myMainDoc = ActiveDocument With myMainDoc.MailMerge '------------------------------------------- 'ファイル名の指定 '------------------------------------------- Dim myFieldName As String myFieldName = "出力ファイル名" If IsValidFieldName(.DataSource.FieldNames, myFieldName) = False Then MsgBox "フィールド名が間違っています", vbExclamation Exit Sub End If '------------------------------------------- '差し込み印刷の設定 '------------------------------------------- '新規文書に書き出す .Destination = wdSendToNewDocument '空白の差し込みフィールドを印刷しない .SuppressBlankLines = True '------------------------------------------- '本処理 '------------------------------------------- Dim i As Integer 'レコード番号 Dim iMax As Integer '対象となる最終レコード番号（レコード数ではない） .DataSource.ActiveRecord = wdLastRecord iMax = .DataSource.ActiveRecord Dim j As Integer: j = 0 '作成したファイルの通し番号 For i = 1 To iMax '全レコードを対象にループ処理 'レコードの指定（1つのレコードに限定） With .DataSource .FirstRecord = i .LastRecord = i .ActiveRecord = i End With On Error Resume Next .Execute If Err = 0 Then '------------------------------------------- 'レコードが対象として選択されている場合：差し込み印刷を実行 '------------------------------------------- j = j + 1 Dim myFileName As String: myFileName = .DataSource.DataFields(myFieldName).Value If myFileName = "" Then myFileName = "★" & myFieldName & "：不明★" myFileName = myFileName 'ファイル名：通し番号+指定したフィールドの値 '新規文書に名前をつけてdocx形式で保存 Dim myNewDoc As Document: Set myNewDoc = ActiveDocument myNewDoc.SaveAs FileName:=myMainDoc.Path & "\" & "出力\" & myFileName & ".docx", _ FileFormat:=wdFormatXMLDocument, _ AddToRecentFiles:=False Dim myFilePath As String '保存先のフォルダパス Dim myDoc As Document Dim intPos As Integer 'ピリオドの位置 Set myDoc = ActiveDocument '拡張子のない名称を取得 myFileName = myDoc.Name intPos = InStrRev(myFileName, ".") myFileName = Left(myFileName, intPos - 1) 'PDFファイルで保存 myFilePath = myMainDoc.Path 'Wordファイルと同じフォルダ myDoc.ExportAsFixedFormat _ OutputFileName:=myFilePath & "\" & "出力\" & myFileName & ".pdf", _ ExportFormat:=wdExportFormatPDF Kill myMainDoc.Path & "\" & "出力\" & myFileName & ".docx" Set myDoc = Nothing myNewDoc.Close DoEvents Set myNewDoc = Nothing Else '------------------------------------------- 'レコードが対象として選択されていない場合：エラー発生 '------------------------------------------- Err.Clear End If Next i End With Set myMainDoc = Nothing End Sub Function IsValidFieldName(myFieldNames As Object, myFieldName As String) As Boolean IsValidFieldName = False Dim myName As Object For Each myName In myFieldNames If myName.Name = myFieldName Then IsValidFieldName = True Exit For End If Next End Function

質問日時: 2023/09/12 08:34 質問者: Ninjya2436

解決済

3

0
Vba ユーザ定義関数について教えてください

いつもお世話になりますユーザ定義関数は使ったことないので教えてください今、他人がプログラムの修正に取り組んでいます二つのシートにユーザ定義関数があり、 Application.Volatileを定義して自動再計算関数にしていますさらに下記のような定義も行っています Dim targetCell As Range, sht As Worksheet Set targetCell = Application.Caller '...2個のシートのマクロを計算する Set sht = targetCell.Parent '...それぞれのマクロのシート名さて、ユーザ定義関数は各シートのセル上で =@calc_myu_x(I39,J39) として使われているのですが、この＠マークの意味が分かりません Webでいろいろ調べましたがどこにも出ていないのですが何か意味が有るのでしょうか？分かりましたら教えてください以上、宜しくお願い申し上げます

質問日時: 2023/09/11 11:22 質問者: 公共ごま

ベストアンサー

1

1
【VBA】エクセルで最後の不要な改行コードを削除するコードについて

Excel（office365）を使っている者です。以下はクリップボードに値のみをコピーするコードですが，範囲内に空白行があった場合，クリップボードには余計な改行が入ってしまいます。最後の余計な改行を消したいため，ネットで調べて，For Each ary In Selection～nextを入れたのですが，型が一致しないということでエラーになってしまいます。どうすれば余計な改行を削除できるか，ご教示願います。よろしくお願いいたします。 --------------------------------------------------------------------------- Sub 値のみコピー() Dim ary As Variant ary = Range("A10:J30").Value Dim myDO As New DataObject Dim i As Long, j As Long Dim strBuf As String For i = 1 To UBound(ary, 1) For j = 1 To UBound(ary, 2) strBuf = strBuf & ary(i, j) Next strBuf = strBuf & vbCrLf '改行コードを付加 For Each ary In Selection If Len(ary.Value) > 0 Then Do While Right(ary.Value, 1) = vbLf ary.Value = Left(ary.Value, Len(ary.Value) - 1) Loop End If Next Next myDO.SetText strBuf myDO.PutInClipboard Set myDO = Nothing End Sub

質問日時: 2023/09/08 18:41 質問者: qazxcvfr4

ベストアンサー

3

1
【VBA】エクセルで値のみクリップボードにコピーするコードについて（貼り付け時の空白削除）

office365のExcelを使っている者です。以前ここで，エクセルで選択した範囲の値のみをクリップボードにコピーする以下のコードを教えていただき，現在も使用しております。適切に動いていると思いますが，一点気になることがあります。クリップボードにコピーされたデータを貼り付けると，横方向のセルの区切り（エクセルをcsvにしたときのコンマ区切りに相当するもの）にスペースのような空白（以下「空白」）が入ってしまい、間延びした感じになってしまいます。「空白が削除された状態でクリップボードにコピーされる」又は「クリップボードにコピーされたデータにつき空白が削除された状態にする」というコードにするには，どのようにしたら良いかご教示ください。 Sub 値のみコピー() Dim ary As Variant ary = Range("A10:J30").Value '選択範囲の値を一旦配列に格納 ' Dim myDO As New DataObject Dim myDO As Object Set myDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") Dim i As Long, j As Long Dim strBuf As String For i = 1 To UBound(ary, 1) For j = 1 To UBound(ary, 2) strBuf = strBuf & ary(i, j) & vbTab Next strBuf = Left(strBuf, Len(strBuf) - 1) '右のタブコードを削除 strBuf = strBuf & vbCrLf '改行コードを付加 Next myDO.SetText strBuf myDO.PutInClipboard Set myDO = Nothing End Sub

質問日時: 2023/09/06 23:37 質問者: qazxcvfr4

ベストアンサー

3

1
VBA 毎日取得するデータを反映させる方法の応用

先日こちらで質問してすごくぴったりなVBA構文を教えていただきました！で、またもや問題が出てきました。教えてもらってばかりで申し訳ないのですが、教えてください。先日いただいた回答は Sub CSV入力1() Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim i As Long, j As Long Dim maxrow As Long Dim wrow As Long varFileName = Application.GetOpenFilename(FileFilter:="CSV〇〇店売上日計(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If maxrow = Cells(Rows.Count, "A").End(xlUp).Row '最終行取得 wrow = maxrow + 1 '書き込み開始行 intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'CSVファィルをオープン i = 0 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み i = i + 1 '最初の1～14行はスキップする。15行以降を処理する If i > 14 Then strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For j = 0 To UBound(strSplit) Cells(wrow, j + 1) = strSplit(j) Next wrow = wrow + 1 End If Loop Close #intFree End Sub 毎日送られてくるデータをコツコツ取得する分には十分なのですが、例えば月曜日のデータを取得するのを忘れて火曜日に取得しようとするとできないようです。（うちの会社が本社は日曜日が休みですが、営業所は日曜日開いているので、どうしても日曜のデータは月曜に取り込むことになります）指定したファイルを順番に取得してけるような構文などありましたら教えてもらいたいです。どうぞよろしくお願いいたします。

質問日時: 2023/09/05 16:32 質問者: KYAC

ベストアンサー

2

0
xlsmファイルで、別名ファイルを保存する方法

Sub ファイル保存() 保存場所 = ActiveWorkbook.Path & "\" Application.DisplayAlerts = False Thisworkbook.SaveAs 保存場所　& "あたらしいファイル名称" & ".xlsm" End Sub このマクロを実行すると、マクロを含むファイルの名前が、あたらしいファイル名称という名前になってしまいます。やりたいのは、マクロを含むファイルはそのままの名前で、あたらしいファイル名称.xlsm というファイルを作成することです。どうすればよいか教えてください。

質問日時: 2023/09/04 21:25 質問者: Ninjya2436

解決済

1

0
Vba Windows上で開いているファイル名を取得したい

いつもお世話になります今、廉価版のCadソフトをコントロールしたのですが、このソフト立ち上げるとキーにな反応しないというか、どこかをクリックしないとうまくコントールしません使う前にメッセージを出してどこかをクリックしてもらえれば問題ないのですが AppActivateで使うキャプション名もWebを参考に取得できるようにしましたがこのプログラムは出来ませきゃぷちおんめいぷちおんめいキャプション名、"ARES Standard 2024”にしかならずエラーになりますちなみにキャプション名は新規ファイルは、"ARES Standard 2024 - [NONAME_0.dwg]" 既存ファイルは、”ARES Standard 2024 - [C:/temp/F1階 D中間スラブ　抵抗モーメント図.dwg]" が正解ですなんとかキャプション名が分かればコントロール出来るのです！（クラス名は分かっています） ShowWindowやSetForegroundWindowも使ってみましたが立ち上げりのウインドウハンドルは目的ではないウインドウハンドルを持ってきて真っ白な画面になってしまいますどこかクリックして動かせば正常なのですが、ファイル名（NONAMEも含めて）さえ分かればこの手間をなくせますそこで現在Windows上で開いているファイル名を拾え無いかと相談に伺いましたちょっと分かりづらい文章になってしまいました、分かりましたら是非教えてください特定なオペレーションでのプログラムであれば「こうしなさい」で終わるのですが不特定多数の人がどうのように使ってもある程度は許容出来るソフトを目指していますのでどうかよろしくお願い申し上げます

質問日時: 2023/09/04 18:24 質問者: 公共ごま

ベストアンサー

1

0
教えて下さい！VBAで複数Excelを1つのブックにまとめたいです。

はじめまして。VBA初心者のため、お知恵を貸してください。 1つのフォルダの中に、いちご10月、いちご11月、みかん9月、なし8月、、という形で、月別のフルーツの売り上げデータが複数あります。このExcelを、フルーツ別に1つのブックにまとめたいのですが、どのようなマクロにすればよいでしょうか。→例　いちご売上高　というExcelに、10月、11月というシートがついているイメージ 1、まとめたエクセルには、フルーツ名と売上高(例　いちご売上高.xlsx)というファイル名にしたいです。 2、月別のExcelに、シートは1つだけです。(月がシート名。例　10月) 3、フルーツによって、売上がない月もあります。 Excelの数が多く、手作業に時間がかかってしまうのでマクロでの作業に変更したいです。よろしくお願いします。。

質問日時: 2023/09/04 09:30 質問者: kappasan4646

ベストアンサー

3

0
基本情報技術者の擬似言語プログラムこのプログラムの答えは(ウ)です。でも配列に格納されてる順番が良

基本情報技術者の擬似言語プログラムこのプログラムの答えは(ウ)です。でも配列に格納されてる順番が良く分からなくて困ってます。教えて頂けるととてもありがたいです。 array に　後ろから格納されて行く事が分かります。例えばグラフ3の自分を始点となる辺が1つもない頂点　E を最初に選んだとすると，プログラムの9行目で array ［グラフの項点の数ーcount＋1］← curr.label を実行すると， array［6ー1＋1］←E を代入することになりますが，そうすると　array［4］←E になりますので　出力結果と異なります。なぜでしょうか分かる方がいたらよろしくお願いします。

質問日時: 2023/09/03 09:48 質問者: サノくん

解決済

2

1
入力した文字を全て自動で全角にしてくれるコード

エクセルで「指定した行」に「入力した文字」を『自動的に全角になる』ようにするＶＢＡコードを教えて下さい入力した文字：全ての文字（漢字、ひらがな、カタカナ、記号、英数字）指定した行：Ｂ列全体 B列のどのセルにおいても、画像1-ｶ-Aをと入力したら入力したセルに「画像１－カ－Ａ」と全て全角に変換されて入力されるようにしたいです。行いたいシートの名前を右クリックしてコードの表示左側の一覧から行いたいシートをダブルクリックコードをコピペでよいのですか？ＶＢＡは覚えて多少なりとも使えるように理解できれば便利でしょうが、難しくてなかなか理解できません。

質問日時: 2023/09/03 07:16 質問者: satopower

ベストアンサー

3

0
離れた複数のセルのどこかに文字が入った場合に、⚫が表示されるようにしたいです

資格の有無と有効期限管理をするにあたり、有効期限を入力すると、資格の有無を表すセルに●が表示されるように設定したいです。現状、A1（←資格の有無を表示するセル）には　=IF(DG17<>"","●","")　と入力しうまく反映できていますが（←DG17は有効期限を入れるセル）とある資格は細かい分類があるため有効期限を入力するセルが複数存在します。例えば、BE17に●を表示させたいのですが有効期限を入力するセルは FV17・FZ17・GD17　の3か所に点在しています。このいずれかに有効期限をいれた場合、●がつくようにしたいのです。このような場合に使用できる数式はありますでしょうか。よろしくお願いいたします。

質問日時: 2023/09/01 11:06 質問者: ちきぽん

ベストアンサー

3

0
シートモジュールを複数作成することはできるのでしょうか？

全く詳しくないので上手く質問できるか分からないのですが… 1つのシートの中で、かつ、別のエリアでダブルクリックで記号を表示させたいです。 ①AK6からCG6 間の行に対して、ダブルクリックで○が表示されるようにしたい。 ②AK17からCG500のすべてのセルに対して、ダブルクリックで⚫と◎が表示されるようにしたい今自分なりに下記をコード？に入れてみたところ、②についてはクリアできたのですが①について追加できず困っています。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("AK17:CG500")) Is Nothing Then Exit Sub With Target Select Case .Value Case "" .Value = "●" Case "●" .Value = "◎" Case "◎" .Value = "" End Select End With End Sub ご教授いただけますでしょうか？

質問日時: 2023/08/30 18:48 質問者: ちきぽん

ベストアンサー

2

0
合計数量から引いていく

ｖｂａをネットで検索しながら作成しているのですが、うまくいかず困っています。お助けいただけたら嬉しいです。やりたいことは、Ｙ列「複数ロットＮｏ」が空白ではない場合、Ｑ列の「合計数量」を分割していく。言い換えると、同じ入荷ＮＯ（Ｆ列）のものを、予定使用数（Ｚ列）に合わせて実際使用数（ＡＡ列）に分割していく。 ※添付図面の左から右にしたいです。右図に追加したものは、わかりやすく赤字にしてあります。 ①Ｙ列が「1」の場合、Ｑ列とＺ列を比較する。Ｚ列が大きければ、Ｑ列の値をＡＡ列に転記。 ②Ｙ列が「1」で、Ｑ列とＺ列を比較してＱ列が大きければ、Ｚ列の値をＡＡ列に転記する。 ③1行下がって、Ｙ列が「2」のＺ列と、1行上のＹ列が「1」の「Ｑ列－Ｚ列」を比較する。Ｚ列が大きければ、Ｙ列が「1」の「Ｑ列－Ｚ列」を転記。 ④Ｚ列が小さければ、Ｙ列が「1」の「Ｑ列－Ｚ列」からＹ列が「2」のＺ列を引く。合計数量が0になるまで繰り返し。数が余った場合は、同じ入荷ＮＯの最終列に加算。ＩＦを使用して、作成してみたのですがＩＦだらけになり非常にわかりにくくなってしまいました。複数ロットＮＯは1～5まであり、3まで作成した段階で断念しました。いい方法があれば、ご教示いただけると助かります。 ----------------------------------------------------------------- 　Dim m As Long Dim i As Long Dim wSG As Worksheet With wSG For i = 2 To lRowG If .Cells(i, "Y").Value <> "" Then If .Cells(i, "Y").Value = 1 Then If .Cells(i, "Z").Value <= .Cells(i, "Q").Value Then .Cells(i, "AA").Value = .Cells(i, "Z").Value m = .Cells(i, "Q").Value - .Cells(i, "Z").Value If .Cells(i, "H").Value = 2 Then .Cells(i + 1, "AA").Value = m ElseIf .Cells(i, "H").Value = 3 Then If .Cells(i + 1, "Z").Value <= m Then .Cells(i + 1, "AA").Value = .Cells(i + 1, "Z").Value .Cells(i + 2, "AA").Value = m - .Cells(i + 1, "AA").Value Else .Cells(i + 1, "AA").Value = m End If Else .Cells(i + 1, "AA").Value = m End If End If Else .Cells(i, "AA").Value = .Cells(i, "Q").Value End If End If End If Next i End With

質問日時: 2023/08/29 19:53 質問者: tatituteto7410

ベストアンサー

1

0
A2～I4179列にあるリストを支社名ごとにシートに分けたいです。各シート名はA列にある支社名とし

A2～I4179列にあるリストを支社名ごとにシートに分けたいです。各シート名はA列にある支社名としたい。各シートごとに分けたリストにはリストの見出しをつけたい。以下VBAコードで実施するとリストの見出しに該当するA2～I2が支社名シートとして1つのシートになり他のシートのリストに付与されないです。どこを修正したら良いかご教示お願いします。 Sub SheetSeparation() Dim lastRow As Long Dim i As Long Dim sheetName As String ' シート名「元データ」にデータがある前提 sheetName = "元データ" ' 元データの最終行を取得 lastRow = Sheets(sheetName).Cells(Rows.Count, "A").End(xlUp).Row ' 支社名ごとにシートを作成 For i = 2 To lastRow ' B列の値を取得 Dim companyName As String companyName = Sheets(sheetName).Cells(i, "A").Value ' 支社名のシートが存在しなければ作成 If Not WorksheetExists(companyName) Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = companyName End If ' データをコピーしてシートに貼り付け Sheets(sheetName).Rows(i).Copy Destination:=Sheets(companyName).Cells(Rows.Count, "A").End(xlUp).Offset(1) Next i End Sub Function WorksheetExists(sheetName As String) As Boolean On Error Resume Next WorksheetExists = Not Sheets(sheetName) Is Nothing On Error GoTo 0 End Function

質問日時: 2023/08/29 16:46 質問者: HS83als

解決済

3

1
VBA 毎日取得するデータを順番に反映していく方法

１週間程ずっと調べているのですがどうしてもわからず質問させていただきます。システムから売上日計を集計するとCSVファイルとして出力されます。ファイル名は20230826160630（西暦年月時分秒）_general_purpose.csvとなります。そのファイルをエクセルに取込み、毎月の集計を行いたいのです。例えば　　集計するエクセルのSheet１（”データ”と名前を設定しています）に月曜日の日計を取り込むところまではできましたが、火曜日のCSVファイルを取り込もうとしたら月曜日の日計が上書きされてしまいます。私としては、月曜日のデータの下の行に火曜日のデータ、水曜日のデータが取り込めたらいいなと思っています。ちなみに売上日計ですので月曜日が１０行分のデータだったり、火曜日は１５行分のデータだったりします。例）A1～A１０は月曜日のデータが反映　　Ａ１１～Ａ２５は火曜日のデータが反映　　Ａ２6～Ａ３７は水曜日のデータが反映　　▽ 　　▽ 　　▽ 　　１か月分すべてＳｈｅｅｔ１（”データ”）に反映わかりにくいかもしれませんが、ご教示お願いいたします。

質問日時: 2023/08/26 16:22 質問者: KYAC

ベストアンサー

6

0
vba GetAsyncKeyState関数について

いつもお世話になります昨日の質問は、fujillinから教わったGetAsyncKeyState関数でうまく行きましたありがとうございましたところでもう一つ質問下記のようにマウス左クリックとEnterキーでチェックしたところ GetAsyncKeyState(vbKeyReturn)は最初 1 が入ってきますそこでカウントを取ってプログラムは実行していますが何故だか教えていただけると幸いです errCount = 0 Do If GetAsyncKeyState(vbKeyLButton) <> 0 Then Exit Do ElseIf GetAsyncKeyState(vbKeyReturn) <> 0 Then If errCount > 0 Then Exit Do Else errCount = errCount + 1 End If End If Loop DoEvents 以上、宜しくお願い申し上げます

質問日時: 2023/08/24 12:08 質問者: 公共ごま

ベストアンサー

1

0
VBA 「，」・空白・カタカナ等の複数条件のマクロ

いつも皆様ありがとうございます。前回、VBAで質問させて頂いた内容なのですが条件が変わったところ VBAがエラーとなりました。理由は空白等複数の条件が変更となったためだと思われます。やりたいことは ①同じシートのA列にデータを表示させたい ②「，」より前を表示させたい ③文字間に空白がある場合は削除 ④空白セル、ひらがな、漢字、カタカナ（全角半角英数字）はそのまま表示どなたかよろしくお願いします。

質問日時: 2023/08/23 11:57 質問者: mihomiho34

ベストアンサー

2

0
★お手上げ状態です。助けてください。ActiveReportについて

ActiveReportのサブレポート機能で最初のサブレポートエリアだけ何も表示されない ActiveReportのサブレポート機能を利用して会社の社員毎の情報を6件1ページに表示させようとしています。デザイナの問題かと思い6件から5件に件数を減らしサブレポートの領域を十分にとって確実に表示できるように変更しましたが1件目のサブレポートのエリアだけ真っ白で何も表示されません 2ページ目以降は設定したサブレポートの数だけちゃんと表示されます。 ★デザイナの領域の問題では無いのかなと思っています。次にイベントの問題 pageのフッターヘッダーのイベント全て削除。グループフッター、ヘッダーのイベント全て削除。 ★pageとグループのヘッダー、フッターイベントではない事を確認次にSQLの確認 1件目からデータが取得できていることを確認 detailのbeforeプリントでme.XXXX.txtに1件目からデータがバインドされていることを確認 ★データはちゃんとバインドされている以上のことからもう、お手上げ状態です。

質問日時: 2023/08/20 04:27 質問者: 39OK

解決済

1

1
ＶＢＳでフォルダ内のエクセルデータ削除

いつもお世話になっておりますＶＢＳでフォルダ内のエクセルデータ削除だけ全て削除したいのでずがわかる方おしえてくれませんでしょうか

質問日時: 2023/08/19 20:00 質問者: りんごプリン

解決済

1

0
ActiveReportのサブレポート機能を利用したときに1ページ目の1サブレポート目が表示されない

ActiveReportのサブレポート機能を利用して会社の社員毎の情報を6件1ページに表示させようとしているのですが1ページ目の1件目のデータだけタイトルとかバインドデータとか何も表示されませ。2ページ目以降は6件きちんと表示されます。 ※1.SQLでは1件目もちゃんとデータとってこれています。 ※2.サブレポートはdetailセクションで利用しております ★サブレポートの1ページ目の1件だけ表示されない理由として何か考えられる事ありますか？

質問日時: 2023/08/19 06:10 質問者: 39OK

解決済

1

0
VBE でスペースと改行を見えるように設定することって可能でしょうか？Excel です。カーソルを

VBE でスペースと改行を見えるように設定することって可能でしょうか？Excel です。カーソルを上下移動する際移動先に行末のスペースがあるのか、すでに改行され何もないのか見えたら便利だと思うのですがそれらしき設定が見当たらず、、詳しい方、何卒お願い申し上げます。

質問日時: 2023/08/19 04:49 質問者: g2saru

解決済

3

0
Vba UserFormを前面に出す方法を教えてください

いつもお世話になります今、Vbaを使ってAutoCad LTに作図（Scriptファイルを使う）するプログラムを作成中ですが終了後にUserformを前面に出したいと思っています先日は作図前にAutoCAdを前面に出す方法を教わったのですが今度はExcelのUserformを前面に出して次のステップに行けるようにしたいと考えています今のプログラムは Me.Hide '...Excelを最小化 Application.WindowState = xlMinimized Application.Wait [Now() + "00:00:02"] '...2秒待つ '...AutoCadを前面に AppActivate "Autodesk AutoCAD" check = ShowWindow(dwghwnd, 3) SetForegroundWindow dwghwnd '...最前面表示　　　　　（作図） Me.Show になっています Me.ShowのところでUserFormを前面に出したいのですが分かりましたら教えてください以上、よろしくお願い申し上げます

質問日時: 2023/08/17 11:08 質問者: 公共ごま

ベストアンサー

1

2
ActiveReportのdetailをデータセットの自動バインドを使って帳票を出力しています。

VB.netでActiveReportのdetailをデータセットの自動バインドを使って帳票を出力しています。例 SQL select id,name,add1,add2,tel from table 帳票 detailセクションに txtId(テキストボックス）⇒txtIdのプロパティのデータフィールドにidを設定してバインド txtName(テキストボックス）⇒txtNameのプロパティのデータフィールドにnameを設定してバインド add1 add2も同様にテキストボックスのプロパティ、データフィールドにSQLのカラム名を設定してバインド ★ここで「tel」だけ使わなかったのですが、帳票に非表示にしてtxtTel(テキストボックス）を配置してあげればすむ話なのですが、detailセクションにそんな余白領域がありませんし管理が大変です。 ※detailには例に挙げた項目よりものすごい量のデータが配置されていて余白がありません。 ★質問detailのbefore_print？イベントでコードで「tel」を取得したいのですがサンプルコードを記載願いませんでしょうか

質問日時: 2023/08/16 07:16 質問者: 39OK

ベストアンサー

1

0

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

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

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

質問する（無料）

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

カスハラとクレームの違いは？カスハラの法的責任は？企業がとるべき対応は？

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

今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
大麻の使用罪がなかった理由や法改正での変更点、他国との違いを弁護士が解説

ドイツで2024年4月に大麻が合法化され、その2ヶ月後にサッカーEURO2024が行われた。その際、ドイツ警察は大会運営における治安維持の一つの方針として「アルコールを飲んでいるグループと、大麻を吸っているグループ...
ピンとくる人とこない人の違いは？直感を鍛える方法を心理コンサルタントに聞いた！

根拠はないがなんとなくそう感じる……。そんな「直感がした」という経験がある人は少なくないだろう。ただ直感は目には見えず、具体的な説明が難しいこともあるため、その正体は理解しにくい。「教えて！goo」にも「...