问题描述
PrivateSubCommandButton1_Click()DimMyColAsNewCollectionDimTxtColAsNewCollectionDimMyColAAsNewCollectionDimiAsLongDimmyArr(300)AsStringDimfsoAsObjectDimstrFolderPathAsStringDimobjFolderAsObjectDimobjFileAsObjectDimxlAppAsExcel.ApplicationDimxlBookAsExcel.WorkbookDimMyArray()AsStringDimTxtArray()AsStringDimsheetAsExcel.WorksheetDimiNumAsIntegerDimaNumAsIntegerDimsAsIntegerDimpaAsStringDimpaTAsStringDimcountAsIntegerDimArr(100)AsStringDimtxtAsStringDimcountNumAsIntegerDimtabNameAsStringDimowUerAsStringDimusTblAsStringDimarrayaAsVariantDimabcAsIntegerDimbcdAsStringDimtAsInteger'DimabcAsString'abc="sheet1,sheet2"'arraya=Split(abc,",")'MsgBoxarraya(0)Setfso=CreateObject("Scripting.FileSystemObject")strFolderPath="D:DDL"SetobjFolder=fso.GetFolder(strFolderPath)IfNotobjFolderIsNothingThenForEachobjFileInobjFolder.FilesMyCol.Add(Mid(Left(objFile.Name,Len(objFile.Name)-4),8))MyColA.Add(objFile.Name)NextEndIfSetxlApp=NewExcel.Application'????excel?審fSetxlBook=xlApp.Workbooks.Open("D:EP作業一覧.xls")Setsheet=xlBook.Worksheets(2)sheet.Cells(3,2)="2"'MsgBoxsheet.Cells(3,2)iNum=sheet.[C6553].End(xlUp).RowSetxlBookA=xlApp.Workbooks.Open("D:EPEPテーブル設計.xls")SetsheetA=xlBookA.Worksheets(2)aNum=sheetA.[A6553].End(xlUp).RowReDimPreserveMyArray(iNum)AsStringFors=1ToiNumMyArray(s-1)=sheet.Range("C"&s+1).ValueNextsForm=0ToUBound(MyArray)-1Forj=1ToMyCol.countIfMyArray(m)=UCase(MyCol.Item(j))Then'Forf=jToMyColA.count'Fory=6ToaNumOpen"D:DDL"&MyColA.Item(j)ForInputAs#1DoWhileNotEOF(1)LineInput#1,txt'????????審??弌????泙暘攝?String?検countNum=countNum+1IfcountNum=1ThenowUer=Replace(Mid(txt,6),"]","")EndIfIfcountNum=14ThenusTbl=UCase(Replace(Mid(txt,21),"](",""))EndIfIfcountNum>14Thenabc=InStr(txt,"]")bcd=Mid(txt,3,abc-3)'arraya=Split()Forq=6ToaNumIfsheetA.Cells(q,2).Value=owUerAndsheetA.Cells(q,3).Value=usTblThenForo=3ToxlBookA.Worksheets.count'MsgBoxsheetA.Cells(q,3).Value'MsgBoxxlBookA.Worksheets(o).NameIfsheetA.Cells(q,3).Value=xlBookA.Worksheets(o).NameThenSetsheetC=xlBookA.Worksheets(o)'MsgBoxsheetC.[A6553].End(xlUp).RowForp=7TosheetC.[A6553].End(xlUp).Row'MsgBoxsheetC.Cells(p,3).Value'MsgBoxbcdIfUCase(bcd)=sheetC.Cells(p,3).ValueThent=t+1sheetC.Cells(p,1)=tEndIfNext'Workbooks("EPテーブル設計.xls").Worksheets(sheetC.Name).Activate'Range("A7:P"&sheetC.[A6553].End(xlUp).Row).Select'ActiveWorkbook.Worksheets(sheetC.Name).Sort.SortFields.Clear'ActiveWorkbook.Worksheets(sheetC.Name).Sort.SortFields.AddKey:=Range("A7"),_'SortOn:=xlSortOnValues,Order:=xlAscending,DataOption:=xlSortNormal'WithActiveWorkbook.Worksheets(sheetC.Name).Sort'.SetRangeRange("A7:P"&sheetC.[A6553].End(xlUp).Row)'.Header=xlNo'.MatchCase=False'.Orientation=xlTopToBottom'.SortMethod=xlPinYin'.Apply'EndWithEndIfNextEndIfNextIfTrim(Left(txt,11))="CONSTRAINT"ThenGoToLoopline'EOF()=TrueEndIfEndIfLoopLoopline:'NextcountNum=0'NextEndIfNextjNextmxlBook.Close(True)xlApp.QuitClose#1SetobjFile=NothingSetobjFolder=NothingSetfso=NothingEndSub注释的地方是小弟要排序地方也就是先对excel进行修改然后排序