常連

### 実現したいこと
タイトルの通りではありますが、
エクセル表のなかで、複数の特定文字を絞り込み、特定文字が入っていない行のデータをクリアしたいです。

### 発生している問題・分からないこと
Sub 不要行の削除

Dim LastRow As Long
Dim i As Long
Dim i As Long
Dim Target As Variant

‘最終行取得
LastRow = Cells (Rows. Count, 1). End(x|Up). Row

'くだもの
Target =Array (”りんご，ふどう，もも”)

Application. DisplayAlerts = False
With ActiveSheet

’最終行から先頭へルーブ←
For i = LastRow To 12 Step -1

For i = 0 To UBound(Target)

‘くだものに該当しなければ行削除
If Instr(Cells(i, 2), Target (j)) = 0 Then
. Rows (i) .Delete
End If

Next j
Next 
End With
Application. DisplayAlerts = True

End Sub



エクセル表(12行目から開始で参照はB列)
1lすいか
2lりんご
3lかき
4lぶどう
5lなし
6lいちご
7lもも

期待する実効値は
2lりんご
4lぶどう
7lもも

なのですが、全て削除されてしまいます。
おそらく複数の特定文字の指定で、
「りんご　かつ　ぶどう　かつ　もも」
というフィルターがかかってしまっているとは思うのですが、
「りんご　または　ぶどう　または　もも」
が入っている行以外の行を削除するフィルターにするにはどのような関数を使えばよろしいのかおしえていただきたいです！



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

```
特になし
```

### 試したこと・調べたこと
- [ ] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [x] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
teratailで同様の事案がないか確認したところ、見つかりませんでした。

### 補足
特になし

【VBA】複数の特定文字が入っていない行の削除

### 実現したいこと
VBAで実行するマクロで昇順に取得したい

### 発生している問題・分からないこと
下記サイトを参考に変更前のフォルダ名を一括取得するマクロを作成したのですが、昇順で取得にはどのように内容を変更すれば良いのでしょうか？
お手数ですが、ご教示のほどよろしくお願いいたします。
https://www.higashisalary.com/entry/vba-folder-rename



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

```
特になし
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [ ] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
他サイトを検索してみたのですが、実現方法がわからず詰まっております、

### 補足
特になし

VBAのファイル名取得にて、昇順で取得する方法がわかりません

### 実現したいこと

エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい


### 前提

エクセルには入力と「印刷」と「名前」の付けた２つのシートがあります。
「入力」シートの"H7～H36"に「A」「B」「C」「AB」「BC」と5つの文字列をプルダウンリストで設定してあります。
この"入力!H7"にプルダウンで「AB」もしくは「B」が入力された場合に「印刷」シートの"D5""E5""F5""G5"のセルに斜線が表示れるようにしたいです。
また"入力!H8"に「AB」「B」を入力すると今度は「印刷」シートの"D56""E56""F56""G56"に斜線を表示、"入力!H8"に"D107""E107""F107""G107"に罫線といった処理をしたいです。


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

現在は名前の定義で「A」「B」「C」「AB」「BC」それぞれの名前を付けたセルに斜線を引いて、INDIRECT関数を使い「印刷」シートに罫線の画像を表示する方法でごまかしているのですが、動作が極端に遅いため、マクロやVBAを使って表示できないかと思い、質問させていただきました。
### 補足情報（FW/ツールのバージョンなど）

Microsoft　365
Windows 10


エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい

### 実現したいこと
英文字を含めた12桁以上の数値を繰り返し連番で出したいです。 

例:Y40000000001
    Y40000000002…
```VBA

Range("A2").Select Selection.NumberFormatLocal = "@"
 Range("A2").AutoFill Destination :=Range(A2:A1000)
 Application.WindowState = xlNormal

```

### 発生している問題・分からないこと
英文字を含めた12桁以上の数値を繰り返し連番する方法がわかりません。



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

```
特になし
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
英文字を含めた12桁以上の数値を繰り返し連番する方法を検索したり、自分で変えたりしてみましたが、上手くいきませんでした。

### 補足
特になし

Excel VBAで12桁以上の数値の連番について

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で特定の色がついたセルがある場合に処理をする。

以下のマクロを実行すると「現状の実行結果」のように天気が実行されます。
転記元ファイルの担当者に空白があると、同開発のその下の担当者のところで処理が止まってしまいます。（空白を無しにすると正常に実行されるのは確認しています）

処理の途中で空白のセルが存在した時に、今回でいうと「実装したい実行結果」のように、その行だけをスキップして処理を継続させるようにしたいのですが、インターネットなどで調べ、以下の「該当箇所（現状のソースの一部）」でその部分を実装しようとしたのですが、なかなかうまくできないので、教えていただきたいです。

該当箇所（現状のソースの一部）
```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 マクロで処理中に空白のセルが存在するときのスキップ方法

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