0

フォルダーにはいくつかの Excel があります。すべての Excel は同じテンプレートに従います。すべてのシートに「K」列があります。すべての個別のコードを個別の Excel ファイルに保存したい (Excel ファイルにコード 15478、15478、および 17832 がある場合、両方のコード 15478 を持つ 1 つの Excel ファイルがあり、17832 を持つ 2 番目の Excel ファイルがあるように)。これは、フォルダー内に存在するすべての Excel ファイルに対して行う必要があります。

strPath="C:\Testr"
Set objExcel= CreateObject("Excel.Application")
objExcel.Visible= True

Const xlUp= -4162

'To store every excel sheet column values in array
Dim a(), val

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)

'To pick out the only distinct values from array
 Set objDict= CreateObject("Scripting.Dictionary")
 objDict.CompareMode = vbTextCompare

'Searching for xls files
For Each objFile In objFolder.Files
If objFso.GetExtensionName(objFile.Path) = "xls" Then
    objExcel.Workbooks.Open(objFile.Path)


    'Counting all the used rows
    With objExcel.Activeworkbook.Sheets("PAAF")
    rowcount=.Range("A" & .Rows.Count).End(xlUp).Row-2

    msgbox rowcount
    End With

    'dynamic array
    Redim Preserve a(rowcount)

    'Collecting distinct values in dictionary object
    for i=7 to rowcount
        a(i-7) = objExcel.Activeworkbook.Sheets("PAAF").Cells(i,11).Value
    objDict(a(i-7)) = a(i-7)

    Next


    n = objDict.Items

    REM The problem is here, though i am able to get unique values,
     REM but these values are getting processed for every excel because 
     REM the loop is starting for 0 .Ex- if one sheet is having code 19873,
     REM it will get processed for second sheet also whether it is present that 
     REM or not.

    For i=0 to ubound(n)
    msgbox n(i)




With objExcel.Activeworkbook.Sheets("PAAF")

    'Passing dictionary stored values to apply autofilter on    
    .Range("K6").AutoFilter 11,"="& n(i)

End With

fn=objFso.GetFileName(objFile.Path)
objExcel.Activeworkbook.saveAs("C:\Test2\"&"Output"& fn &i &".xls")

Next    

これらの値にフィルターを適用するために配列から個別の値を取得する他の方法はありますか?私は自分の問題を説明するために最善を尽くしましたが、何か明確でない場合はお知らせください....! Excelシートのテンプレート

4

0 に答える 0