空のシートに関数を入れたい

質問失礼いたします。
下記コードの

Worksheets.Add after:=Worksheets(Worksheets.Count)

で、シート貼り付け時に空のシートを追加しています。
このシートに関数の

=IF(INDEX(果物の!A:A,ROW())=INDEX(出荷!A:A,ROW()),"○","×")


を入れたいのですがどうすればよろしいでしょうか。
分かる方お教えください。宜しくお願い致します。

下記コードです。

Sub 検索()
Dim fn(10000) 'フォルダ内ファイル名
Dim sn(10000, 2) 'フォルダ内エクセルファイル名、シート名
Dim i As Long, j As Long, k As Long, x As Long
Dim myPath As String 'フォルダパス
Dim ext As String '拡張子検索変数
'フォルダの選択
With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログ表示
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
myPath = .SelectedItems(1) 'パス取得
Else
Exit Sub
End If
End With
Application.ScreenUpdating = False '画面更新非表示
'ファイル名の取得
fn(1) = Dir(myPath & "\", vbDirectory)
i = 1
Do
i = i + 1
fn(i) = Dir
Loop Until fn(i) = ""
'シート名の取得
x = 0
For j = 1 To i - 1
ext = Mid(fn(j), InStrRev(fn(j), ".") + 1, 3) '拡張子取得
'エクセルファイルの時実行
If ext = "xls" Then
Workbooks.Open Filename:=myPath & "\" & fn(j)
For k = 1 To Sheets.Count
sn(x, 1) = fn(j) 'エクセルファイル名取得
If InStr(Sheets(k).Name, Range("A1").Text) > 0 Then
sn(x, 2) = Sheets(k).Name 'シート名取得
x = x + 1
End If
Next k
ActiveWorkbook.Close
End If
Next j
'シート名一覧の作成
Columns("A:B").Select
Selection.ClearContents
Cells(2, 1) = "作業フォルダ"
Cells(3, 1) = myPath
Cells(4, 1) = "ファイル名"
Cells(4, 2) = "シート名"
x = 0
Do
Cells(x + 5, 1) = sn(x, 1)
Cells(x + 5, 2) = sn(x, 2)
x = x + 1
Loop Until sn(x, 1) = ""
Range("A1").Select
Application.ScreenUpdating = True '画面更新表示
MsgBox "完了しました"
End Sub
'シート名ダブルクリックすると実行
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim fn As String, bk As String, pth As String
Dim ptBk As Workbook, ptBk_pth As String
Dim myname As String



If Intersect(Target, Range("B5", Cells(Rows.Count, "B").End(xlUp))) Is Nothing Then Exit Sub
Cancel = True
pth = Range("A3").Value
bk = Target.Offset(, -1).Value
fn = Target.Value



ptBk_pth = Application.GetOpenFilename("Excelブック,*.xls?") 'コピー先のブック選択
If ptBk_pth = "False" Then Exit Sub 'キャンセル時終了
Application.ScreenUpdating = False '画面更新非表示
Set ptBk = Workbooks.Open(ptBk_pth)
With Workbooks.Open(pth & "\" & bk)
Application.EnableEvents = False 'イベントを抑止
.Sheets(fn).Copy Before:=ptBk.Sheets(1)
Application.EnableEvents = True
.Close savechanges:=False 'コピー元は保存せず閉じる
End With

myname = InputBox("シート名を入力してください", "シート名を入力")


If myname = "" Then
End
Else
ActiveSheet.Name = myname

End If

Worksheets.Add after:=Worksheets(Worksheets.Count) '一番右に空のsheetを追加



ptBk.Close savechanges:=True 'コピー先は保存し閉じる
Application.ScreenUpdating = True '画面更新表示
End Sub

No.1 ベストアンサー 回答者： mygoonickname 回答日時： 2021/12/03 15:14

こんにちは。

マクロの記録で、その関数を設定すれば良いのでは？と思います。
出来上がったコードを見て、必要に応じて修正し、提示したマクロへ
それを組み込めばと思います。

因みに、同様に、シート追加、関数を入れるを繰り返されるのでしょうか？
例えば、既に関数の入っているシートを準備して、それを原紙として準備
しておき、必要な時に、そのシートをコピーするでは、ダメでしょうか？
原紙シートが邪魔なら、隠しておくとか。
（余り手間が掛かるなら、今のシートを追加＆関数挿入の方が良いかも
知れませんが。）

この回答へのお礼

返信遅くなり申し訳ありません。
便利な機能教えていただき、ありがとうございます！
マクロの記録よくわかっていなかったのですが、調べてやってみたところすぐできました。
すごい便利なものなんですね
活用していきたいと思います。助かりました！

＞因みに、同様に、シート追加、関数を入れるを繰り返されるのでしょうか？
＞必要な時に、そのシートをコピーするでは、ダメでしょうか？
何度もやります。ですので、そのたびにコピー貼り付けすると、時間かかってしまうのでマクロで、と考えています。

お礼日時：2021/12/03 16:13

No.2 回答者： fujillin 回答日時： 2021/12/03 16:27

こんにちは

対象はActiveWorkBookでよいのでしょうか？

セル範囲に式を設定するには、
　Range(対象範囲).FormulaLocal = "式"
で、まとめて関数式を設定できます。


例えば、ご提示の式をセルA1:A100に設定する場合なら、

Worksheets(Worksheets.Count).Range("A1:A100").FormulaLocal = _
"=IF(INDEX(果物の!A:A,ROW())=INDEX(出荷!A:A,ROW()),""○"",""×"")"

で、できると思います。

この回答へのお礼

コード教えていただき、ありがとうございます！
上記のものでも出来ました、ありがとうございます！！

お礼日時：2021/12/03 16:46