Q&A
「for~j」のところで エラーとのことですが、ループ内ということですよね。
どこで止まるか分かりますか？
Sub mPFC_analysisのfor~jのところでエラーコード400が出てしまい、何が間違っているのかわかりません。教えてください。
vba
1Option Explicit 2Sub mPFC_analysis(ByVal book As Excel.Workbook) 3 4'Application.ScreenUpdating = False 5 6With book 7 .ActiveSheet.Name = "Sheet1" 8End With 9 10book.Worksheets("Sheet1").Activate 11book.Worksheets("Sheet1").Copy after:=Worksheets("Sheet1") 12ActiveSheet.Name = "analyzed" 13 14With book 15 With Worksheets("analyzed") 16 17 .Columns(1).Insert 18 .Rows(1).Insert 19 20 Dim x As Long 21 x = .Cells(Rows.Count, 2).End(xlUp).Row 22 23 Dim i As Long 24 For i = 2 To x 25 26 .Cells(i, 1).Value = i - 22 27 28 Next 29 30 .Range("B1").Value = "CS+R" 31 .Range("D1").Value = "CS+omi" 32 .Range("F1").Value = "CS-R" 33 .Range("H1").Value = "CS-omi" 34 35 .Range(.Cells(2, 3), .Cells(x, 3)).Interior.ColorIndex = 1 36 .Range(.Cells(2, 5), .Cells(x, 5)).Interior.ColorIndex = 1 37 .Range(.Cells(2, 7), .Cells(x, 7)).Interior.ColorIndex = 1 38 39 .Range("K3").Value = "CS+R" 40 .Range("M3").Value = "CS+omi" 41 .Range("O3").Value = "CS-R" 42 .Range("Q3").Value = "CS-omi" 43 44 .Range("K4").Value = "CS" 45 .Range("L4").Value = "US" 46 .Range("M4").Value = "CS" 47 .Range("N4").Value = "US" 48 .Range("O4").Value = "CS" 49 .Range("P4").Value = "US" 50 .Range("Q4").Value = "CS" 51 .Range("R4").Value = "US" 52 53 .Range("J5").Value = "min" 54 .Range("J6").Value = "time" 55 .Range("J7").Value = "max" 56 .Range("J8").Value = "time" 57 .Range("J9").Value = "magnitude" 58 .Range("J10").Value = "a.u.c" 59 60 61 Dim j As Long 62 For j = 1 To 4 63 64 '''''min 65 .Cells(5, j * 2 + 9).Value = WorksheetFunction.Min(.Range(.Cells(22, j * 2), .Cells(32, j * 2))) 'CS 66 Dim minrowCS As Long 67 minrowCS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(5, j * 2 + 9).Value) 68 .Cells(6, j * 2 + 9).Value = .Cells(minrowCS, 1) 69 70 .Cells(5, j * 2 + 10).Value = WorksheetFunction.Min(.Range(.Cells(33, 2), .Cells(x, 2))) 'US 71 Dim minrowUS As Long 72 minrowUS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(5, j * 2 + 9)) 73 .Cells(6, j * 2 + 9).Value = .Cells(minrowUS, 1) 74 75 '''''max 76 .Cells(7, j * 2 + 9).Value = WorksheetFunction.Min(.Range(.Cells(22, j * 2), .Cells(32, j * 2))) 'CS 77 Dim maxrowCS As Long 78 maxrowCS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(7, j * 2 + 9)) 79 .Cells(8, j * 2 + 9).Value = .Cells(maxrowCS, 1) 80 81 .Cells(7, j * 2 + 10).Value = WorksheetFunction.Min(.Range(.Cells(33, 2), .Cells(x, 2))) 'US 82 Dim maxrowUS As Long 83 maxrowUS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(7, j * 2 + 9)) 84 .Cells(8, j * 2 + 9).Value = .Cells(maxrowUS, 1) 85 86 '''''magnitude 87 If Abs(.Cells(5, j * 2 + 9).Value) - Abs(.Cells(7, j * 2 + 9).Value) >= 0 Then 'CS、minの方が大きい 88 .Cells(9, j * 2 + 9).Value = .Cells(5, j * 2 + 9).Value 89 Else 90 .Cells(9, j * 2 + 9).Value = .Cells(7, j * 2 + 9).Value 91 End If 92 93 If Abs(.Cells(5, j * 2 + 10).Value) - Abs(.Cells(7, j * 2 + 10).Value) >= 0 Then 'US、minの方が大きい 94 .Cells(9, j * 2 + 10).Value = .Cells(5, j * 2 + 10).Value 95 Else 96 .Cells(9, j * 2 + 10).Value = .Cells(7, j * 2 + 10).Value 97 End If 98 99 '''''a.u.c 100 Dim aucCS As Long 101 aucCS = WorksheetFunction.Average(.Range(.Cells(22, j * 2), .Cells(32, j * 2))) 'CS 102 .Cells(10, j * 2 + 9).Value = Abs(aucCS) * 1 103 104 Dim aucUS As Long 105 aucUS = WorksheetFunction.Average(.Range(.Cells(32, j * 2), .Cells(x, j * 2))) 'US 106 .Cells(10, j * 2 + 10).Value = Abs(aucUS) * 5 107 108 Next 109 110 End With 111End With 112 113'Application.ScreenUpdating = True 114End Sub 115 116Sub Batch_mPFC_analysis() 117 118 Dim bkWork As Workbook '作業用ワークブック 119 Dim bk As Workbook 'コピー元ワークブック 120 Dim shtIni As Worksheet '初期ワークシート 121 Dim folderPath As String '処理対象のフォルダパス 122 Dim tmpSinw As Long 'SheetsInNewWorkbook一次記憶用 123 Dim tmpDa As Boolean 'DisplayAlerts一次記憶用 124 Dim itm As Object 125 Dim fd As Office.FileDialog 126 127 128 'Excelファイルが保存されているフォルダを選択 129 Set fd = Application.FileDialog(msoFileDialogFolderPicker) 130 fd.AllowMultiSelect = False '複数選択しない 131 fd.Title = "Excelファイルが保存されているフォルダを選択" 132 If fd.Show = True Then 133 folderPath = fd.SelectedItems(1) '選択したフォルダのパスを変数に格納 134 Else 135 Exit Sub 'フォルダが選択されなかった場合は処理終了 136 End If 137 138 139 140 'ファイルの処理にFileSystemObjectオブジェクトを利用 141 With CreateObject("Scripting.FileSystemObject") 142 '指定したフォルダ内のファイルを順番に処理 143 For Each itm In .GetFolder(folderPath).Files 144 '処理対象となるファイルの拡張子を指定 145 Select Case LCase(.GetExtensionName(itm.Path)) 146 Case "xls", "xlsx", "xlsm" ', "csv" 147 'Set bkSrc = Application.Workbooks.Open(itm.Path) 'コピー元のワークブックを開く 148 149 Set bk = Workbooks.Open(itm.Path) 150 151 Call mPFC_analysis(bk) 152 153 Application.DisplayAlerts = False '上書き保存して閉じる 154 bk.Save 155 bk.Close 156 157 End Select 158 Next 159 160 161 End With 162 163Application.DisplayAlerts = True 164 MsgBox "operation finished", vbInformation 165 166End Sub 167 168コード
回答1件
0
ベストアンサー
Findで止まるというお話ですので、以下ですかね。
VBA
1Dim minrowCS As Long 2minrowCS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(5, j * 2 + 9).Value)
変数minrowCSには、検索結果のセルの値が入るようですが、
まず、その処理であっていますか？
であれば、変数minrowCSがLong型なので、検索したセルの値が数値以外になっていませんか？
もしくは、見つかったセルの行番号を取得したいのであれば、
VBA
1.Find(.Cells(5, j * 2 + 9).Value).Row
のように最後に「.Row」が必要では。
投稿2021/09/09 07:22
総合スコア761
Dim minrowCS As Long
minrowCS = .Range(.Cells(2, j * 2), .Cells(21, j * 2)).Find(.Cells(5, j * 2 + 9).Value).Row
.Cells(6, j * 2 + 9).Value = .Cells(minrowCS, 1)
と直してみましたが、今度は「オブジェクト変数またはwithブロック変数が設定されていません」と出てしまいました。
おっしゃる通りに検索して得た行数をminrowCSに入れているつもりでしたが何がいけないでしょうか？
Findの検索結果は見つかる前提でよろしいですか？
見つからないと、そのようなエラーが出ます。
すいません、検索する範囲を間違えていました。できるようになりました。ありがとうございます。
あなたの回答
tips
プレビュー
