列出文件夹中的所有文件和Excel文件夹中的子文件夹
我需要列出networking中的所有文件和文件夹，因此需要更快更好的VBA目录列表器。
这个问题在很多论坛上都有提到，在这里也是如下的链接。
使用VBA循环浏览文件夹中的文件？
获得vba的子目录
列出文件夹和子文件夹中的文件，path为.txt文件
我已经使用了一些，并修改了这里的代码
http://www.mrexcel.com/forum/excel-questions/56980-file-listing-all-files-including-subfolders-2.html并在下面给出。
'Force the explicit delcaration of variables Option Explicit Sub ListFiles() 'Set a reference to Microsoft Scripting Runtime by using 'Tools > References in the Visual Basic Editor (Alt+F11) 'Declare the variables Dim objFSO As Scripting.FileSystemObject Dim objTopFolder As Scripting.Folder Dim strTopFolderName As String Dim n As Long Dim Msg As Byte Dim Drilldown As Boolean 'Assign the top folder to a variable With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Title = "Pick a folder" .Show If .SelectedItems.Count = 0 Then MsgBox "Operation Cancelled by the user", vbExclamation + vbOKOnly, "List Files": Exit Sub strTopFolderName = .SelectedItems(1) Msg = MsgBox("Do you want to list all files in descendant folders, too?", _ vbInformation + vbYesNo, "Drill-Down") If Msg = vbYes Then Drilldown = True Else Drilldown = False End With ' create a new sheet If Len(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)) < 31 Then ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1) Else: ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Left(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1), 31) End If 'Insert the headers for Columns A through F Range("A1").Value = "File Name" Range("B1").Value = "Ext" Range("C1").Value = "File Name" Range("D1").Value = "File Size" Range("E1").Value = "File Type" Range("F1").Value = "Date Created" Range("G1").Value = "Date Last Accessed" Range("H1").Value = "Date Last Modified" Range("I1").Value = "File Path" 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the top folder Set objTopFolder = objFSO.GetFolder(strTopFolderName) 'Call the RecursiveFolder routine Call RecursiveFolder(objTopFolder, Drilldown) 'Change the width of the columns to achieve the best fit 'Columns.AutoFit 'ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).TableStyle = "TableStyleLight1" MsgBox ("Done") ActiveWorkbook.Save Sheet1.Activate End Sub Sub RecursiveFolder(objFolder As Scripting.Folder, _ IncludeSubFolders As Boolean) 'Declare the variables Dim objFile As Scripting.File Dim objSubFolder As Scripting.Folder Dim NextRow As Long Dim strTopFolderName As String Dim n As Long Dim maxRows As Long Dim sheetNumber As Integer maxRows = 1048576 'Find the next available row NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 'Loop through each file in the folder For Each objFile In objFolder.Files 'to take complete filename in column C and extract filename without extension lso allowing for fullstops in filename itself Cells(NextRow, "A") = "=LEFT(RC[+2],FIND(""#"",SUBSTITUTE(RC[+2],""."",""#"",LEN(RC[+2])- LEN(SUBSTITUTE(RC[+2],""."",""""))))-1)" 'to take complete filename from row C and show only its extension Cells(NextRow, "B") = "=TRIM(RIGHT(SUBSTITUTE(RC[+1],""."",REPT("" "",LEN(RC[+1]))),LEN(RC[+1])))" Cells(NextRow, "C").Value = objFile.Name Cells(NextRow, "D").Value = Format((objFile.Size / 1024), "000") & " KB" Cells(NextRow, "E").Value = objFile.Type Cells(NextRow, "F").Value = objFile.DateCreated Cells(NextRow, "G").Value = objFile.DateLastAccessed Cells(NextRow, "H").Value = objFile.DateLastModified Cells(NextRow, "I").Value = objFile.Path NextRow = NextRow + 1 Next objFile ' If "descendant" folders also get their files listed, then sub calls itself recursively If IncludeSubFolders Then For Each objSubFolder In objFolder.SubFolders Call RecursiveFolder(objSubFolder, True) Next objSubFolder End If 'Loop through files in the subfolders 'If IncludeSubFolders Then ' For Each objSubFolder In objFolder.SubFolders ' If Msg = vbYes Then Drilldown = True Else Drilldown = False ' Call RecursiveFolder(objSubFolder, True) 'Next objSubFolder 'End If If n = maxRows Then sheetNumber = sheetNumber + 1 ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 'ActiveSheet.Name = "Sheet-" & sheetNumber ActiveSheet.Name = strTopFolderName & "_" & sheetNumber n = 0 End If n = n + 1 End Sub 另一个是从该网站再次使用迪尔
http://www.mrexcel.com/forum/excel-questions/656026-better-way-listing-folders-subfolders-contents.html
Sub ListFiles() Const sRoot As String = "C:\" Dim t As Date Application.ScreenUpdating = False With Columns("A:C") .ClearContents .Rows(1).Value = Split("File,Date,Size", ",") End With t = Timer NoCursing sRoot Columns.AutoFit Application.ScreenUpdating = True MsgBox Format(Timer - t, "0.0s") End Sub Sub NoCursing(ByVal sPath As String) Const iAttr As Long = vbNormal + vbReadOnly + _ vbHidden + vbSystem + _ vbDirectory Dim col As Collection Dim iRow As Long Dim jAttr As Long Dim sFile As String Dim sName As String If Right(sPath, 1) <> "\" Then sPath = sPath & "\" Set col = New Collection col.Add sPath iRow = 1 Do While col.Count sPath = col(1) sFile = Dir(sPath, iAttr) Do While Len(sFile) sName = sPath & sFile On Error Resume Next jAttr = GetAttr(sName) If Err.Number Then Debug.Print sName Err.Clear Else If jAttr And vbDirectory Then If Right(sName, 1) <> "." Then col.Add sName & "\" Else iRow = iRow + 1 If (iRow And &H3FF) = 0 Then Debug.Print iRow Rows(iRow).Range("A1:C1").Value = Array(sName, _ FileLen(sName), _ FileDateTime(sName)) End If End If sFile = Dir() Loop col.Remove 1 Loop End Sub
与dir相比，FilesystemObject的速度更慢。
所以，我的问题是
如何使用Dir将第二个代码修改为第一个格式，以在代码中包括“FileName（as Formula），创builddate，上次访问date，上次修改date”属性。 （代码给“FileDateTime（sName）”date和时间，但我需要这些在前面的代码。）
此外，如果列表超出行限制，代码应该创build另一个文件夹名称为2等，并从结束的地方继续。
其次，我需要从Sheet1.Range（“A2”），End（Xlup）以及不使用filedialog或硬编码的另一个工作表范围中获取多个文件夹path，创build文件夹选项卡并一次运行一个文件夹path的代码。
将所有Long和Integer数据types转换为CLngPtr(variable)
在Sub行之后添加Application.ScreenUpdating = False 。
在End Sub行之前添加Application.ScreenUpdating = True 。
'MODULE 2 'TAT CA HAM CON DUOC GOI CHO HAM CHINH '*****************************************************************************' '01: Clear_Array(name_array, index_array) **********' '02: Getdata_Row_Array(array_data, row_data, col_start, col_end) **********' '03: Cut_String(text_cut(), text_condition, data_ouput()()) **********' '04: Filldata_IO(array_data(), row_start, size) **********' '05: Fill_Number_IO(row_start, col_start, size) **********' '*****************************************************************************' '==================================================================== 'STT: 01 = 'Ten Ham: Clear_Array(name_array, index_array) = 'Chuc nang: Xoa all phan tu mang ve "" = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Clear_Array(name_array() As String, INDEX_ARRAY As Integer) For i = 1 To INDEX_ARRAY name_array(i) = "" Next i End Sub '==================================================================== 'STT: 02 = 'Ten Ham: Getdata_Row_Array(array_data, row_data, col_start, col_end)= 'Chuc nang: Lay du lieu vao mang tu hang va cot da chi dinh = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Getdata_Row_Array(array_data() As String, ByVal row_data As Integer, ByVal col_start As Integer, ByVal col_end As Integer) For i = 1 To (col_end - col_start + 1) array_data(i) = Cells(row_data, col_start + (i - 1)).Value Next i End Sub '==================================================================== 'STT: 03 = 'Ten Ham: Cut_String(text_cut(), text_condition, data_ouput()()) = 'Chuc nang: Cat chuoi lam 2 tu text chi dinh dua vao mang = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/21 = '==================================================================== Public Sub Cut_String(text_cut() As String, TEXT_CONDITION As String, data_ouput() As String) Dim position_find As Integer For i = 1 To Size_Array(text_cut()) position_find = InStr(text_cut(i), TEXT_CONDITION) If position_find <> 0 Then data_ouput(i, 1) = Left(text_cut(i), position_find - 1) data_ouput(i, 2) = Right(text_cut(i), Len(text_cut(i)) - position_find) Else data_ouput(i, 1) = text_cut(i) data_ouput(i, 2) = "" End If Next i End Sub '==================================================================== 'STT: 04 = 'Ten Ham: Filldata_IO(array_data(), row_start, size) = 'Chuc nang: Dien du lieu vao vung input output = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/21 = '==================================================================== Public Sub Filldata_IO(array_data() As String, row_start As Integer, size As Integer) Const COL_NUMBER = 2 Const COL_RET = 5 Const COL_ARG = 8 'Chi so mang array_data Dim index As Integer index = 1 For i = row_start To (row_start + size - 1) Cells(i, COL_NUMBER).Value = index Cells(i, COL_RET).Value = array_data(index, 1) Cells(i, COL_ARG).Value = array_data(index, 2) index = index + 1 Next i End Sub '==================================================================== 'STT: 05 = 'Ten Ham: Fill_Number_IO(row_start, col_start, size) = 'Chuc nang: Dien so vao vung testcase data = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/21 = '==================================================================== Public Sub Fill_Number_IO(row_start As Integer, col_start As Integer, size As Integer) For i = 1 To size Cells(row_start, col_start + i - 1).Value = i Next i End Sub
'MODULE 3 'THU VIEN CHO TAT CA CAC HAM DUNG '*******************************************************************' '01: Search_Cell_Last(row_cell_last,col_cell_last) ' '02: Search_String(text_find, row_find, col_find) ' '03: Insert_Row(row_copy,size_row) ' '04: Insert_Range(row_start,col_start,row_end,col_end,size_range) ' '05: Size_Array(array_exe) ' '06: Clear_Array_2(array_exe()) ' '07: Show_Array(array_data(),size) ' '08: Copy_Range(row_start, col_start, row_end, col_end) ' '09: Paste_Range_Insert(row_seclect, col_select) ' '*******************************************************************' '==================================================================== 'STT: 01 = 'Ten Ham: Search_Cell_Last(row_cell_last,col_cell_last) = 'Chuc nang: Tim o cuoi cung trong mot sheet tra ve han va cot = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Search_Cell_Last(row_cell_last As Integer, col_cell_last As Integer) row_cell_last = ActiveCell.SpecialCells(xlLastCell).Row col_cell_last = ActiveCell.SpecialCells(xlLastCell).Column End Sub '==================================================================== 'STT: 02 = 'Ten Ham: Search_String(text_find, row_find, col_find) = 'Chuc nang: Tim chuoi va tra ve cot va hang o tim duoc = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Search_String(ByVal text_find As String, row_find As Integer, col_find As Integer) Dim row_cell_last As Integer Dim col_cell_last As Integer Call Search_Cell_Last(row_cell_last, col_cell_last) For row_cell = 1 To row_cell_last For col_cell = 1 To col_cell_last If Cells(row_cell, col_cell).Value = text_find Then row_find = row_cell col_find = col_cell Exit Sub End If Next col_cell Next row_cell row_find = 0 col_find = 0 End Sub '==================================================================== 'STT: 03 = 'Ten Ham: Insert_Row(row_copy,size_row) = 'Chuc nang: Chon hang copy va insert xuong phia duoi voi kich thuoc size= 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Insert_Row(row_copy As Integer, size_row As Integer) For i = 1 To size_row Rows(row_copy).Copy Rows(row_copy).Insert Shift:=xlDown Next i End Sub '==================================================================== 'STT: 04 = 'Ten Ham: Insert_Range(row_start,col_start,row_end,col_end,size_range)= 'Chuc nang: Chen range voi kich thuoc size = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Insert_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer, size_range As Integer) For i = 1 To size_range Range(Cells(row_start, col_start), Cells(row_end, col_end)).Insert Shift:=xlToRight Next i End Sub '==================================================================== 'STT: 05 = 'Ten Ham: Size_Array(array_exe) = 'Chuc nang: Xuat ra kich thuoc mang chua du lieu = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Function Size_Array(array_exe() As String) As Integer For i = 1 To UBound(array_exe, 1) If array_exe(i) = "" Then Size_Array = i - 1 Exit Function End If Next i Size_Array = UBound(array_exe, 1) End Function '==================================================================== 'STT: 06 = 'Ten Ham: Clear_Array_2(array_exe()) = 'Chuc nang: Xoa mang 2 chieu ve "" = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/20 = '==================================================================== Public Sub Clear_Array_2(array_2() As String) For i = 1 To UBound(array_2, 1) array_2(i, 1) = "" array_2(i, 2) = "" Next i End Sub '==================================================================== 'STT: 07 = 'Ten Ham: Show_Array(array_data(),size) = 'Chuc nang: Hien thi mang 1 chieu = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/21 = '==================================================================== Public Sub Show_Array(array_data() As String, size As String) For i = 1 To size Debug.Print (array_data(i)) Next i End Sub '==================================================================== 'STT: 08 = 'Ten Ham: Copy_Range(row_start, col_start, row_end, col_end) = 'Chuc nang: Copy vung du lieu = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/22 = '==================================================================== Public Sub Copy_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer) Range(Cells(row_start, col_start), Cells(row_end, col_end)).Copy End Sub '==================================================================== 'STT: 09 = 'Ten Ham: Paste_Range_Insert(row_seclect, col_select) = 'Chuc nang: Dan vung du lieu kieu insert xuong = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/22 = '==================================================================== Public Sub Paste_Range_Insert(row_seclect As Integer, col_select As Integer) Cells(row_seclect, col_select).Insert Shift:=xlDown End Sub
'MODULE 1 '==================================================================== 'STT: 11 = 'Ten Ham: Delete_Row(row_delete) = 'Chuc nang: Xoa mot hang duoc chi dinh voi kich thuoc cho truoc = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/23 = '==================================================================== Public Sub Delete_Row(row_delete As Integer) Rows(row_delete).Delete Shift:=xlUp End Sub '==================================================================== 'STT: 12 = 'Ten Ham: Sum_Range(row_start,col_start,row_end,col_end) = 'Chuc nang: Tinh tong cac so trong mot vung = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/23 = '==================================================================== Public Function Sum_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer) As Integer Dim sum_temp As Integer sum_temp = 0 For row_active = row_start To row_end For col_active = col_start To col_end If IsNumeric(Cells(row_active, col_active)) Then sum_temp = sum_temp + Cells(row_active, col_active) Else MsgBox ("SUM_RANGE: Trong vung tinh tong co du lieu khong phai so.") Sum_Range = 0 Exit Function End If Next col_active Next row_active Sum_Range = sum_temp End Function
'MODULE 3 '==================================================================== 'STT: 10 = 'Ten Ham: Search_Celllast_Data(row_find, col_find) = 'Chuc nang: Tim kiem o cuoi cung co du lieu trong Sheet = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/23 = '==================================================================== Public Sub Search_Celllast_Data(row_find As Integer, col_find As Integer) Dim row_last As Integer Dim col_last As Integer row_find = 0 col_find = 0 'Lay vi tri o cuoi cung trong sheet Call Search_Cell_Last(row_last, col_last) 'Lay ra o cuoi cung co du lieu For row_active = 1 To row_last For col_active = 1 To col_last If Cells(row_active, col_active) <> "" Then 'Lay hang lon nhat co chua du lieu row_find = row_active 'Lay cot lon nhat co chua du lieu If col_find < col_active Then col_find = col_active End If End If Next col_active Next row_active End Sub '==================================================================== 'STT: 11 = 'Ten Ham: Delete_Row(row_delete) = 'Chuc nang: Xoa mot hang duoc chi dinh voi kich thuoc cho truoc = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/23 = '==================================================================== Public Sub Delete_Row(row_delete As Integer) Rows(row_delete).Delete Shift:=xlUp End Sub '==================================================================== 'STT: 12 = 'Ten Ham: Sum_Range(row_start,col_start,row_end,col_end) = 'Chuc nang: Tinh tong cac so trong mot vung = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/23 = '==================================================================== Public Function Sum_Range(row_start As Integer, col_start As Integer, row_end As Integer, col_end As Integer) As Integer Dim sum_temp As Integer sum_temp = 0 For row_active = row_start To row_end For col_active = col_start To col_end If IsNumeric(Cells(row_active, col_active)) Then sum_temp = sum_temp + Cells(row_active, col_active) Else MsgBox ("SUM_RANGE: Trong vung tinh tong co du lieu khong phai so.") Sum_Range = 0 Exit Function End If Next col_active Next row_active Sum_Range = sum_temp End Function '==================================================================== 'STT: 13 = 'Ten Ham: Open_File(path_file) = 'Chuc nang: Mo file bang path = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Sub Open_File(path_file As String) Workbooks.Open Filename:=path_file End Sub '==================================================================== 'STT: 14 = 'Ten Ham: Close_File(file_name) = 'Chuc nang: Dong file bang ten = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Sub Close_File(file_name As String) Windows(file_name).Activate ActiveWindow.Close End Sub '==================================================================== 'STT: 15 = 'Ten Ham: Save_File(file_name) = 'Chuc nang: Luu file bang ten = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Sub Save_File(file_name As String) ActiveWorkbook.Save End Sub '==================================================================== 'STT: 16 = 'Ten Ham: Get_Name_Workbook(number_workbook) = 'Chuc nang: Lay ten cua Workbook dua vao so stt = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Function Get_Name_Workbook(number_workbook As Integer) As String Get_Name_Workbook = Workbooks(number_workbook).Name End Function '==================================================================== 'STT: 17 = 'Ten Ham: Get_Name_Worksheet(number_worksheet) = 'Chuc nang: Lay ten cua Worksheet dua vao so stt = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Function Get_Name_Worksheet(number_worksheet As Integer) As String If number_worksheet <= Sheets.Count Then Get_Name_Worksheet = Worksheets(number_worksheet).Name Else MsgBox ("Thu tu sheet da vuot qua tong so sheets.") End If End Function '==================================================================== 'STT: 18 = 'Ten Ham: Copy_Sheet(name_sheet_copy, location_insert) = 'Chuc nang: Copy sheet moi vao vi tri chi dinh = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Sub Copy_Sheet(name_sheet_copy As String, location_insert As Integer) On Error GoTo EXIT_SUB Sheets(name_sheet_copy).Copy Before:=Sheets(location_insert) EXIT_SUB: MsgBox ("COPY_SHEET_NAME: Ten sheet(" + name_sheet_copy + ") khong ton tai.") End Sub '==================================================================== 'STT: 19 = 'Ten Ham: Delete_Sheet(name_sheet_delete) = 'Chuc nang: Xoa sheet duoc chi dinh = 'Nguoi tao: V.Cong = 'Ngay tao: 2017/05/24 = '==================================================================== Public Sub Delete_Sheet(name_sheet_delete As String) On Error GoTo EXIT_SUB Sheets(name_sheet_delete).Delete Exit Sub EXIT_SUB:
'=========================================='打开文件
Sub Open_File() Const MARU = "MARU" Const BATSU = "BATSU" Const BAR = "BAR" Const PHANTU = 10 Dim path As String Dim number(PHANTU) As String Dim comment(PHANTU) As String ' Get Number Comment 'For index_path = 1 To 5 Sheets(3).Activate path = Cells(7, 1) If path <> "" Then Call GetNumCom(path, number, comment) MsgBox ("Number1:" & number(1)) MsgBox ("Number10:" & number(10)) Else index_path = 100 End If 'Next index_path 'Fill in Result For i = 6 To 20 Sheets(1).Activate If Cells(i, 4) = BATSU Then MsgBox ("Name book:" & ActiveWorkbook.Name & "Name sheet:" & ActiveSheet.Name) For arr_index = 1 To PHANTU If Cells(i, 3) = number(arr_index) Then Cells(i, 5) = comment(arr_index) End If Next End If Next i 'Close Path End Sub '========================================== 'Get Number() Comment Sub GetNumCom(path As String, number() As String, comment() As String) Workbooks.Open path For i = 1 To 10 number(i) = Cells(i, 1).value comment(i) = Cells(i, 3).value Next i ActiveWindow.Close End Sub
'======================= 'Kiem tra da sua loi chua Sub KiemTraSuaLoi() Const ROW_BEGIN = 6 Const COL_STT = 2 Dim last_row, last_col As Integer last_row = ActiveCell.SpecialCells(xlLastCell).Row last_col = ActiveCell.SpecialCells(xlLastCell).Column Dim filename1, filename2 As String filename1 = "file 1" filename1 = "file 2" Dim Col_th(4) As Integer Col_th(1) = 5 Col_th(2) = 7 Col_th(3) = 9 Col_th(4) = 11 ' Dinh nghia cot 1st 2nd 3th 4th For Row = ROW_BEGIN To last_row For Index = 1 To UBound(Col_th, 1) If Cells(Row, Col_th(Index)) <> "" Then If DateValue(Cells(Row, Col_th(Index))) > DateValue(Date) And Cells(Row, Col_th(Index) + 1) = "" Then 'Fill Red 255 Cells(Row, COL_STT).Interior.Color = 255 'Else 'Fill No Color 16777215 'Cells(Row, COL_STT).Interior.Color = 16777215 End If End If Next Index Next Row End Sub