常連

**前提・実現したいこと**
エクセルファイルを同じフォルダ内に、別名保存で保存したい。
（既存ファイルの上書き保存実施後に別名保存させようとしています。）

**発生している問題・エラーメッセージ**
エラーメッセージは特になく、
デスクトップ　または　ドキュメントフォルダに保存されてしまいます。

VBA初心者です。勉強不足で恐縮ですがよろしくお願い板います。


**該当のソースコード**
```
Dim thisPath As String

thisPath = ThisWorkbook.Path

ThisWorkbook.SaveAs Filename:=thisPath & "ファイル名.xls"

```
（不要な部分は割愛しております）

同じフォルダ内に、別名保存で保存したい。

### 実現したいこと

VBAにて、オーバーフローの原因とデータ型の仕組みを知りたい

### 前提

VBAの練習サイトを見ながら、自分でコードを記述するのをやっておりました。
その中で、二点の疑問が生じました。
・自身の記述したコードの「客単価 = 売上 / 客数」において、客単価はどのようなデータ型適しているのか？
・練習サイトに記載してある回答のコードだと問題なく実行されるのは何故か？
です（詳細は以下に記載しております）。どなたか回答してくださると助かります。

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

```
オーバーフローしました。
```

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

自身が作ったコードをデバックしたところ、 「客単価 = 売上 / 客数」に問題があり、客単価のデータ型が間違えているのではと考えています。この場合、どのようなデータ型が一番適しているのでしょうか・・・？
```
Option Explicit

Sub 客単価()
    Dim 売上 As Long
    Dim 客数 As Long
    Dim 客単価 As Long
    Dim i As Long
    For i = 1 To 10
        Cells(i + 1, 2).Value = 売上
        Cells(i + 1, 3).Value = 客数
       客単価 = 売上 / 客数
        Cells(i + 1, 4).Value = 客単価
    Next
End Sub
```
下記の練習サイトの回答を実行したところ、問題なく実行されました。
計算結果は、どのようなデータ型で表されているのでしょうか・・・？
```
Sub 練習問題1()
　　Dim i As Long
　　For i = 2 To 11
　　　　Cells(i, 4).Value = Cells(i, 2).Value / Cells(i, 3).Value
　　Next
End Sub
```

### 試したこと

デバッグ、データ型の検索

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

こちらが練習サイトとなっており、練習1の問題です。
https://excel-ubara.com/excelvba9/EXCELVBA601.html


オーバーフローの原因は特定できたものの、対策が思い浮かばないため皆さんの意見を聞きたいです

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

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

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
```

VBAで特定の色がついたセルがある場合に処理をする。

以下のマクロを記述し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


```

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

以下のマクロを実行すると「現状の実行結果」のように天気が実行されます。
転記元ファイルの担当者に空白があると、同開発のその下の担当者のところで処理が止まってしまいます。（空白を無しにすると正常に実行されるのは確認しています）

処理の途中で空白のセルが存在した時に、今回でいうと「実装したい実行結果」のように、その行だけをスキップして処理を継続させるようにしたいのですが、インターネットなどで調べ、以下の「該当箇所（現状のソースの一部）」でその部分を実装しようとしたのですが、なかなかうまくできないので、教えていただきたいです。

該当箇所（現状のソースの一部）
```Macro
                            '担当者が空白の時スキップする
                            If Cells(n, 3) = " " Then
                                n = n + 1
                            End If
```


現状の実行結果
![イメージ説明](bdfc4fe901e016a05f8901d3b653a789.png)

実装したい実行結果
![イメージ説明](34e0292871b15e442cc9383db9f80494.png)

転記元ファイル（質問用.xls）
![イメージ説明](3dd9c9b33a1e3e6df92e0b0daff7d37c.png)

現状のソース
```Macro
Sub sample1()

    Dim lngRowsNo       As Long                     ' 書きこむ位置
    Dim lngSheetIndex   As Long                     ' シートの番号
    Dim strFile         As String                   ' Excelファイルの場所
    Dim xlsAcq          As New Excel.Application    ' 取得側Excel
    Dim wbAcq           As Workbook                 ' 取得側Excelブック
    Dim wsAcq           As Worksheet                ' 取得側Excelシート
    Dim wsSet           As Worksheet                ' 設定側Excelシート
    Const strPath       As String = ""
    Set wsSet = ActiveSheet
    Dim i As Long

     strFile = Dir(strPath & "*.xls")
    lngRowsNo = 3
    Do Until strFile = ""
        '----- Excelブックを開く
        Set wbAcq = Workbooks.Open(strPath & strFile)

        '----- シートを検索
        For lngSheetIndex = 1 To wbAcq.Worksheets.Count
            '----- 「更新」シートを検索
            If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
                '----- 「更新」シートを変数へ登録
                Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
                '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
                With wsAcq
                Dim fname As String        'ファイル名
                Dim n As Long                  'ループで使用します。
                Dim m As Long                  'ループで使用します。
                Dim ec1 As Long               '各開発の一番下の担当者のセルを取得
                Dim ec2 As Long               '各開発の 月の一番右（最後）のセルを取得
                Dim ColumnNo As Long    ' 転記先の列番号（初期値４）
                Dim ColumnNo2 As Long    ' 転記元の列番号（初期値５）＋３されていく
                
                ColumnNo = 4
                ColumnNo2 = 5

                For i = 1 To .UsedRange.Rows.Count

                    If Left(.Cells(i, 2).Value, 2) = "開発" Then
                     '月を取得して転記
                    ec2 = .Cells(i + 1, 5).End(xlToRight).Column + 1
                    For col = 5 To ec2
                    
                        wsSet.Cells(2, ColumnNo).Value = .Cells(i + 1, ColumnNo2).Value
                        
                        ColumnNo = ColumnNo + 1
                        ColumnNo2 = ColumnNo2 + 3
                        
                    Next col

                    ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
                     'データの入っているところまでループさせる (その時、開発名を転記)
                     ec1 = .Cells(i + 3, 3).End(xlDown).Row
                        For n = i + 3 To ec1
                        
                            'ファイル名
                            fname = ActiveWorkbook.Name
                            wsSet.Cells(lngRowsNo, 1).Value = fname
                            
                            '開発
                            wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
                            
                             '担当者
                            wsSet.Cells(lngRowsNo, 3).Value = .Cells(n, 3).Value
                            
                            '担当者が空白の時スキップする
                            If Cells(n, 3) = "" Then
                                n = n + 1
                            End If
                            
                             '工数
                            wsSet.Cells(lngRowsNo, 4).Value = .Cells(n, 5).Value
                            
                            wsSet.Cells(lngRowsNo, 5).Value = .Cells(n, 8).Value
                            
                            wsSet.Cells(lngRowsNo, 6).Value = .Cells(n, 11).Value
                            
                            wsSet.Cells(lngRowsNo, 7).Value = .Cells(n, 14).Value
                            
                            wsSet.Cells(lngRowsNo, 8).Value = .Cells(n, 17).Value
                            
                            wsSet.Cells(lngRowsNo, 9).Value = .Cells(n, 20).Value
                            
                            wsSet.Cells(lngRowsNo, 10).Value = .Cells(n, 23).Value
                            
                            wsSet.Cells(lngRowsNo, 11).Value = .Cells(n, 26).Value
                            
                            wsSet.Cells(lngRowsNo, 12).Value = .Cells(n, 29).Value
                            
                            wsSet.Cells(lngRowsNo, 13).Value = .Cells(n, 32).Value
                            
                             '１行下へ
                            lngRowsNo = lngRowsNo + 1
                            
                        Next n
                    End If
                Next i
                End With
               
                '----- 検索の終了
                Exit For
            End If
        Next lngSheetIndex

        '----- シート参照の解放
        Set wsAcq = Nothing
        '----- ブックを閉じる
        wbAcq.Close Savechanges:=False
        '----- 次のファイルへ
        strFile = Dir()
    Loop

    '----- Excelへの参照の解放
    Set xlsAcq = Nothing

End Sub
```

VBA マクロで処理中に空白のセルが存在するときのスキップ方法

### 前提・実現したいこと

入力フォームに、日付を入力するテキストボックスがあります。
このテキストボックスにはデフォルトで今日の日付が入っているようにしたいのです。

![作成中の入力フォーム](f70d1375f0e82263487f153270cdd1d5.png)

### 発生している問題・エラーメッセージ

テキストボックスに今日の日付が入りません。

### 該当のソースコード

```VBA
Private Sub UserForm1_Initialize()
    txtDate.Text = Date
    txtDate.Format = "Long Date"
End Sub
```

### 試したこと

以前も別の入力フォームを作ったときに、同様の実装をしているのですが、その際は
```VBA
txtDate.Text = Format(Date, "YYYY/MM/DD")
```
で実装できているので、このようにもしてみましたが、だめでした。

### 補足情報

Excel2010、Win7 64bit版で操作しています。
初心者ですので初歩的なところで躓いている気がしますが、どうぞ皆様ご教示くださいませ・・・。

入力フォームで、テキストボックスに今日の日付が入っているようにしたい

VBAにてオートフィルターのコードを書いています。

「RangeクラスのAutoFilterメゾットが失敗しました。」
というエラーが発生していて困っています。

**やりたい内容

・ユーザーフォームのリストボックスの値を選択する（リストボックスは複数選択でき、５つ用意してある）
・それぞれのリストボックスで選択された項目をANDでオートフィルタ―かけたい**


実際のコードと、ユーザーフォーム、データシートの画像を貼り付けました。
ご参考ください。

どのようなコードにすれば実現できるでしょうか。
ご教示お願い申し上げます。![イメージ説明](dafddff9db5c5b5557f54a7f8d8029e7.png)
![イメージ説明](2bf4d3b66296cc7218e2fbd86d3390f4.png)

```vba
Dim RER() As String
   Dim r As Integer
   Dim rnt As Integer
   

For r = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(r) = True Then
            
            rnt = rnt + 1
            ReDim Preserve RER(1 To rnt)
            RER(rnt) = ListBox1.List(r)
        End If
    Next r
 
   
    
    
 '選択項目でのフィルター
'RERと同様にJER,FER,KER,GERは作成しています
 
  Dim arr As Variant
  arr = Split(Join(RER, ",") & "," & Join(JER, ",") & "," & Join(FER, ",") & "," & Join(KER, ",") & "," & Join(GER, ","), ",")
Worksheets("製品データ").Range("A1").AutoFilter Criteria1:=arr, Operator:=xlFilterValues




```