常連

### 実現したいこと

他のマクロを呼び出しているだけのマクロを開発タブ＞マクロから選択して実行できるようにしたい。

### 発生している問題・エラーメッセージ

他のモジュールにあるマクロを呼び出すマクロが実行できないのですが、それはなぜですか？
どうすれば解決できますか？

例えば
Module1にhogehoge1()というマクロを作成したとします。
これをModule2に

```vb
Sub hogehoge2()
Module1.hogehoge
End Sub
```

として、Module2からModule1にあるhogehoge1を呼び出すマクロhogehoge2を作成しました。

これを開発＞マクロから呼び出そうとしても、hogehoge2を選択しようとすると、実行ボタンが灰色になっていて選択できません。

### 補足情報（FW/ツールのバージョンなど）

Excel2019
Windows

他のマクロを呼び出しているだけのマクロを開発タブ＞マクロから選択して実行できるようにしたい。

### 実現したいこと
プルダウン(数値)が変更されることで、別セルにプルダウンリストを作成するプログラムを作成いたしました。
値の変更時のイベントプロシージャで変更前の値を取得し、変更後も変更前の値を削除することなく、プルダウンを作成することができましたが、Worksheet_SelectionChangeからのWorksheet_Changeを使用しているため、別セルから、B1セルを選択し、プルダウンで数値を変更させると、うまく動くのですが、B1セルをそのまま選択した状態でもう一度B1セルの値を変更すると、うまくプログラムが動作できません。(当たり前ですが。。。)
B1セルをそのまま選択した状態でもう一度B1セルの値を変更しても適用されるプログラムを作りたいと思っているのですが、どのようにすればいのでしょうか？ご意見あれば、お願いたします。

### 前提

「実現したいことを参考にしてください」

■■な機能を実装中に以下のエラーメッセージが発生しました。

特にエラーは出ていませんが、以下のプログラムになにか追記すれば、以下のことができるでしょうか？
「B1セルをそのまま選択した状態でもう一度B1セルの値を変更しても適用されるプログラム」を作成したいと思っております。
### 試したこと

ここに問題に対して試したことを記載してください。

Option Explicit
'============================
'宣言セクション
Dim VAL As Variant
'============================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    On Error GoTo ENDUP
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    If Target.Cells.Count <> 1 Then Exit Sub
    
        VAL = Target.Value

ENDUP:

End Sub
'============================
Private Sub Worksheet_Change(ByVal Target As Range)

    'On Error Resume Next
    
Dim VALafter As Variant
Dim dropDownValues() As String ' ドロップダウンリストの中身を定義

Dim i As Long
Dim k As Variant


dropDownValues = Split("30,35,40,45,50,60,65,70,75,80,85,90,95,100") ' ドロップダウンリストを設定する
    
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
     If Target.Cells.Count <> 1 Then Exit Sub
    
        VALafter = Target.Value
        
      Application.ScreenUpdating = False
        
      If VALafter = VAL Then '例3段→3段
        
        For i = 1 To VALafter
            'If i <= Target.Value Then
            
            k = i * 2 + 1
            
                With Me.Range("D" & k).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Formula1:=Join(dropDownValues, ",")
                    
                    '赤枠にする
                    Range("D" & k).Borders.Color = RGB(255, 0, 0)
                    
                    
                End With
            
        Next i
        
      End If

    
    If VALafter > VAL Then '例:3段→5段
    
        For i = 1 To VALafter
            'If i <= Target.Value Then
            
            k = i * 2 + 1
            
                With Me.Range("D" & k).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Formula1:=Join(dropDownValues, ",")
                    
                    '赤枠にする
                    Range("D" & k).Borders.Color = RGB(255, 0, 0)
                    
                    
                End With
            
        Next i
        
    End If
    
    If VALafter < VAL Then
    
        For i = VALafter + 1 To VAL '例:5段→3段
            'If i <= Target.Value Then
            
            k = i * 2 + 1
            
                Range("D" & k).Validation.Delete 'D3セルからD12セルまでのドロップダウンリストを削除
                Range("D" & k).ClearContents     '数字も削除
                Range("D" & k).Borders.LineStyle = xlLineStyleNone
            
        Next i
               
     End If
     
      Application.ScreenUpdating = True
    
End Sub



値変更することにより、プルダウンリストの数が変更される

### 実現したいこと

プルダウン(C1セル)で選択された名前の図を表示したい。
C1セルで選択した図をSheet1 C4セルに表示させたいです。
図一覧はSheet2に集約しております。

プログラムの流れは
①前回の図を削除→②プルダウンで図の名前を選択→③Sheet2の中にある②で選択した図をコピー→④Sheet1 C4セルに図を表示させる
という流れです。

以前試したこと

以前はシートごとに図を一枚ずつ貼り付けて、プルダウンで名前を指定していたのですが、シートに複数の図を貼り付けて、呼び出せないものかと思い、質問させていただきました。ちなみに一枚ずつシートに貼り付けていたときのプログラムは以下になります


### 発生している問題・エラーメッセージ

下記のコードで実行すると、エラーがでてしまいます。

【実行時エラー1004  指定した名前のアイテムが見つかりませんでした。】
型の問題でしょうか？"imageName"をString型でしてしているのですが、これがまずいでしょうか？

エラーの場所：ActiveSheet.Shapes.Range(Array("imageName")).Select→ここでエラーおきます。

### 該当のソースコード

Private Sub Worksheet_Change(ByVal Target As Range)


Dim imageName As String
Dim pic As Picture


    If Target.Address = "$C$1" Then
    
           
        For Each pic In ActiveSheet.Pictures
        
            If Not Intersect(pic.TopLeftCell, Range("C4")) Is Nothing Then　'図を削除
            pic.Delete
        
            End If
        Next
        
        'C1セルの値を取得

        imageName = Sheets("Sheet1").Range("C1").Value
        
         Sheets("Sheet2").Select　'シート２を選択
        ActiveSheet.Shapes.Range(Array("imageName")).Select　'→C1セル名前の図を選択ですがここでエラー起きます
        Selection.Copy
        
        Sheets("Sheet1").Select
        Range("C4").Select
        ActiveSheet.Paste
        
     End If

End Sub


### 試したこと

以前はSheetごとに図を一枚ずつ貼り付けて、プルダウンで名前を指定していたのですが、シートに複数の図を貼り付けて、呼び出せないものかと思い、質問させていただきました。ちなみに一枚ずつシートに貼り付けていたときのプログラムは以下になります。

Worksheets("Sheet1").Select
                For Each 〇〇 In Worksheets("Sheet2").Shapes
                〇〇.Copy 'オブジェクトをコピー
                ActiveSheet.Paste Link:=False
            
                    With ActiveSheet.Shapes("〇〇")  '変更した図を選択
    
                        '位置とサイズを変更
                        .Top = Range("G2").Top  '位置を指定
                        .Left = Range("G2").Left
                    
                    End With
                Next

### 補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。


プルダウンリストで選択された名前の図を表示したい

### 実現したいこと

・二つのデータの折れ線グラフを作成したい。(横軸;日時、縦軸;計測値)
・全部のデータを利用したブラフを作成する(横軸;測定した日時すべて、縦軸;対応する測定値)
・一日毎のデータグラフを個別(データごと)に作成する。(横軸;一日分の測定時間、縦軸;対応する測定値)
・グラフタイトルを、測定した日付or測定開始から何日目で表示したい。

### 前提

Excelのvbaを利用して、自動で測定したデータからグラフを作成できるようにしたい。データロガーを作成し、一週間ほど、水温と圧力のデータを取得しています。これを、csvファイルにて保存し、excelファイルで読み込みを行い、測定期間全体のグラフと、一日毎のグラフを水温と圧力を別々で表示できるようにしたいです。現在、測定期間全体のグラフを描写するところまではできたのですが、一日毎のグラフにするところで躓いています。
chat gptを活用してプログラムを修正した結果、どんどん悪化してしまったので助けてほしいです。

実装を予定しているcsvファイルは、C列に日時データ、D列に水温、E列に圧力データが格納されています。
イメージですが、下記のようなファイル構造です。

カウント| 時間|          日時          |水温|圧力
    0      |  0   |2023/5/31/12;00| 23  |1013
    1      |  10   |2023/5/31/12;10| 23  |1013
    2      |  20   |2023/5/31/12;20| 22  |1014

### 発生している問題・エラーメッセージ

一日毎のデータグラフになっていません。
エラーメッセージこそ発生していないですが、作成されたグラフが全く違うところのデータを参照しています。
また、一つのグラフに水温・圧力のデータをまとめてグラフにされてしまうのですが、別々にグラフを作ってほしいです。


### 該当のソースコード

```言語;vba Excelマクロ(2016)
ソース

Sub graf_drow_day()
    '変数の型を宣言
    Dim x_ax As Range
    Dim y_ax1 As Range
    Dim y_ax2 As Range
    Dim x_title As String
    Dim y_title As String
    Dim GRF_name As String
    
    'ワークシートを取得する
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    'データ範囲を指定する
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    Set x_ax = ws.Range("C2:C" & lastRow)
    Set y_ax1 = ws.Range("D2:D" & lastRow)
    Set y_ax2 = ws.Range("E2:E" & lastRow)
    
    '横軸縦軸の名前を指定する
    x_title = "Date"
    y_title = "Value"
    
    '横軸縦軸の文字サイズを指定する
    Dim ax_fontsize As Integer
    ax_fontsize = 14
    
    'グラフ作成のための変数を宣言する
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim chartIndex As Integer
    
    'グラフ作成の開始日と終了日を設定する
    startDate = WorksheetFunction.Min(x_ax)
    endDate = WorksheetFunction.Max(x_ax)
    
    '日ごとのグラフを作成する
    currentDate = startDate
    chartIndex = 1
    
    Do While currentDate <= endDate
        'グラフのタイトルを指定する
        GRF_name = "daily-graf (" & Format(currentDate, "yyyy/mm/dd") & ")"
        
        '日付に対応するデータを抽出する
        Dim rngX As Range
        Dim rngY1 As Range
        Dim rngY2 As Range
        Set rngX = x_ax.Cells.Find(What:=currentDate, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rngX Is Nothing Then
            Set rngY1 = y_ax1.Cells(rngX.Row - y_ax1.Row + 1)
            Set rngY2 = y_ax2.Cells(rngX.Row - y_ax2.Row + 1)
            
            'グラフを挿入する
            Dim chart As Shape
            Set chart = ws.Shapes.AddChart2(240, xlXYScatter)
            chart.Name = "Chart" & chartIndex
            
            With chart.chart
            
                '指定したデータでグラフ作成
                .SeriesCollection.NewSeries
                .SeriesCollection(1).XValues = rngX
                .SeriesCollection(1).Values = rngY1
                
                'グラフの名前、タイトル、軸を変更する
                .HasTitle = True
                .ChartTitle.Text = GRF_name
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Text = x_title
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Text = y_title
                .Axes(xlCategory).AxisTitle.Format.TextFrame2.TextRange.Font.Size = ax_fontsize
                .Axes(xlValue).AxisTitle.Format.TextFrame2.TextRange.Font.Size = ax_fontsize
                                
                
                '2つ目のデータ系列を追加する
                .SeriesCollection.NewSeries
                .SeriesCollection(2).XValues = rngX
                .SeriesCollection(2).Values = rngY2
                
                '系列2のグラフの種類を折れ線グラフに設定する
                .SeriesCollection(2).ChartType = xlLine
                
                '系列2のデータポイントにマーカーを表示する
                .SeriesCollection(2).MarkerStyle = -4142 'xlMarkerStyleNone
                
                'グラフの範囲を自動調整する
                .AutoScaling = True
            End With
            
            '次の日に進む
            currentDate = currentDate + 1
            chartIndex = chartIndex + 1
        Else
            '次の日に進む
            currentDate = currentDate + 1
        End If
    Loop
End Sub

```

### 試したこと

For文の範囲を、diffに+1して、繰り返し回数を正常化しました。
diffをprintで表示して、日付計算の確認
グラフ描写範囲や、二つ目のグラフ表示の書き方や範囲指定方法を、for文の中に入れたり、指定方法を変えたりしたのですが、構文エラーや処理落ちをしてしまいました。また、一つのグラフに二つのデータが入る問題が解決できませんでした。

Excelのvbaで一日ごとのデータグラフを描写したい。

### 実現したいこと
VBAのsplit関数で、セル内の文章を段落ごとに区切りたいです。

動作前→動作後のイメージは下記の通りです。（「」は文章の塊を表しており、文章そのものには含まれていません）

（動作前）
「 初めて質問させていただきます。
初心者ですがよろしくお願いいたします。

段落間の空白行は1行だったり、2行だったり、それ以上だったりします。


split関数でなくても同じことが実現できれば大丈夫です。
その場合はコードをいただけるととても助かります。
どうぞよろしくお願いいたします。」

↓
（動作後）

「 初めて質問させていただきます。
初心者ですがよろしくお願いいたします。」
「段落間の空白行は1行だったり、2行だったり、それ以上だったりします。」
「split関数でなくても同じことが実現できれば大丈夫です。
その場合はコードをいただけるととても助かります。
どうぞよろしくお願いいたします」


上記のように段落ごとに分割したいです。段落間の空白行は1行とは限らず、複数行の場合もあります。

### 前提

VBAで実現したいです。

### 発生している問題・エラーメッセージ


    Dim I As Long
    Dim Buf As Variant '配列を指定します。
    
    Buf = Split(対象セル, vbLf+)

    For I = 0 To UBound(Buf)  '配列に分割して格納したデータを繰り返します。
        MsgBox Buf(I)  '分割したデータを順番にメッセージボックスへ表示します。
    Next I
    
だと
vbLf+の表現が正しくない様で、エラーになります。
なお
vbLf+→vbLf
に修正すると
段落ごとではなく、改行ごとに区切ることには成功しています。
例文だと
「初めて質問させていただきます。」
「初心者ですがよろしくお願いいたします。」
「」
「段落間の空白行は1行だったり、2行だったり、それ以上だったりします。」
といった出力結果です。


よろしくお願いいたします。


VBAマクロのsplit関数で、セル内の文章を段落ごとに区切りたいです。

100行3000列ほどのエクセルデータから
キーワード＝項目 が一致する列を抽出したいです。
![![イメージ説明](92cf181d8e4e9f873c181801b3f283a6.gif)
上記のようなデータ一覧から
   A    B   C
１ 年賀状  氏名  誕生日
２
３
｜
のように、キーワードを選択して
その列に入ってる値をすべて抽出したいです。

また、元のデータ量が変動しても、抽出する
キーワードが変更しても使いやすいように
「元のデータは」セル範囲指定でなく
シート全部もしくは編集中のセル全てを対象としたいです。

キーワードは可能であれば
元のデータとは別シートに記載すると
その別シートのキーワードの列（下）に反映されるようにしたいです。

以前に投稿されていた
【マクロ】検索に一致した条件とその下のセルを抽出
を参考に作成したのですが、
検索設定を行ごとに記述が必要なため、
変動する元のデータに対応しきれませんでした。
マクロを書き換えるのはキーワードが変更になった時だけに
なるような方法で記述するにはどうすれはいいでしょうか？

ご教授のほどよろしくお願い申し上げます。

【マクロ】選択した項目の列をすべて抽出して別シートへ

以下のマクロを記述しsheet上にボタンを設置しマクロを実行しようとしたのですが

なぜか、「マクロ’test’を実行できません。
このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります。」と出てきます

このsheet上には他にもボタンを設置しているのですが他のマクロは問題なく動きます

また、このマクロもボタンではなくフォームの実行からだと正常に動きます

このような問題はどうすれば解決するのでしょうか？

verはexcel2016です

```

Sub test()


'セルK22～L22の範囲を切り取り、K21を基点に貼り付け

Range("K22:L22").Cut Destination:=Range("K21")

Range("K10:L21").Select
Selection.Copy



End Sub


```

マクロ’ ’を実行できません。  このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります。

VBAで書きたいです。

特定の範囲(出来れば図のような範囲、難しい場合はシート全体からでもOK)に
オレンジがあればB1セルに[A]、オレンジがない場合はB1セルに[B]と記載したい場合
どの様にコードを書いたらいいでしょうか。

こんな感じかな、と書いてみたのですが、見当違いなようで動きません。

どなたかアドバイスお願いします。

![イメージ説明](e5f26fb0f03a8b005a5862cdf6a24d72.png)

```VBA
Sub Test()
    
    Dim Flag
    
	Select Case True
		Case Range("I8:T17").Interior.ColorIndex = RGB(0、166、93)　　　　　'緑
		Case Range("I8:T17").Interior.ColorIndex = RGB(237、28、36)　　     '赤
		Case Range("I8:T17").Interior.ColorIndex = RGB(255, 255, 255)　　   '白　　
		Case Else
			Flag = False
	End Select
	
	If Flag = False Then
		Range("B2") = "〇"
	Else
		Range("B2") = "×"
	End If
		

End Sub
```