VBA之获取目录（二）

接上一篇，如果我们获取完目录，需要生成新的sheet页

Sub main() Dim line As Integer Dim row As Integer Dim dic_arr(0 To 10) As String Dim dic_index As String Dim sheetname As String dic_index = 0 row = 1 For line = 0 To 16 line = line + 1 If Worksheets("sheet1").Cells(line, row) = "" And Worksheets("sheet1").Cells(line, row + 1) = "" Then row = getback(line, row, dic_index) line = line - 1 End If If Worksheets("sheet1").Cells(line, row) = "" And Worksheets("sheet1").Cells(line, row + 1) <> "" Then row = row + 1 line = line - 1 End If If Worksheets("sheet1").Cells(line, row) <> "" Then dic_arr(dic_index) = Worksheets("sheet1").Cells(line, row) dic_index = dic_index + 1 If Worksheets("sheet1").Cells(line + 1, row + 1) <> "" Then If Worksheets("sheet1").Cells(line + 2, row + 2) <> "" Then For cnt = 0 To Index - 2 sheetname = sheetname & Mid(dic_arr(cnt), 2, 2) Next sheetname = sheetname & Mid(dic_arr(Index), 2, 2) & Mid(dic_arr(cnt), 5, Len(dic_arr(cnt))) 'create sheet Worksheets.Add Activesheets.Name = sheetname End If End If Else 'copy data End If Next End Sub Function getback(line As Integer, row As Integer, dic_index As String) Do While Worksheets("sheet1").Cells(line, row) = "" row = row - 1 dic_index = dic_index - 1 Loop row = getback End Function

以上代码参考。