フォルダーにはいくつかの 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シートのテンプレート