到目前为止，我有两个不同的唯一值（X，Y）。如果条件x<>y不相等，我想将其余的唯一值放入数组中，并需要创建一个带有数组值（其余唯一值）的工作簿。
前任：
X Y
SAP Siemens
Siemens otto
Otto Allianz AG
Accenture Oracle
Oracle Capgemini
TCS Daimler
Infosys Akka
我已经有工作簿，例如“ Siemens.xlsx”，“ Oracle.xlsx”，“ Otto.xlsx”。现在，我需要数组中Y列的其余唯一值。我的预期结果应该是“ Akka.xlsx”，“ Allainz AG。xlsx”，“ Daimler.xlsx”。
代码：
Sub array()
Dim y as range
Dim c as integer
Dim Lastrow_Y As Integer
Dim Lastrow_X As Integer
Dim rngFilter_Y as range
Dim rngCopy as range
Dim NewBook as workbook
With Master_workbook.Worksheets("FBI")
Sheets("FBI").Columns("C:C").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AZ1"), Unique:=True
Lastrow_Y = .Cells(.Rows.Count, "AY").End(xlUp).Row
End with
With Master_workbook.Worksheets("WWF")
Sheets("WWF").Columns("d:d").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("AY1"), Unique:=True
Lastrow_X = .Cells(.Rows.Count, "AY").End(xlUp).Row
End with
For c = 2 To Lastrow_Y
Set y = Master_workbook.Sheets("FBI").Range("AZ" & c)
Set x = Master_workbook.Sheets("WWF").Range("AY" & c)
If x = y Then
set NewBook = workbooks.add
with NewBook
.Title = y NewBook.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = "www"
With rngFilter_Y
.AutoFilter field:=32, Criteria1:="<>(a) 0 - 360", Operator:=xlFilterValues
.AutoFilter field:=37, Criteria1:=y.Value, Operator:=xlFilterValues
Set rngCopy = .SpecialCells(xlCellTypeVisible)
.AutoFilter ' Switch off AutoFilter
End With
.SaveAs Filename:= Y & ".xlsx"
rngCopy.Copy NewBook.Worksheets("www").Cells(1, 1)
Else
End If
Next
End sub
如果有人帮助我，我将不胜感激。
在我看来，检查当前文件夹中已创建的文件会容易得多，然后仅创建Y范围中尚不存在的文件？
Option Explicit
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder : Set folder = fso.GetFolder(<path to your .xlsx files here>)
Dim file, fileNames, lastRowY, row, checkFile, newBook
For Each file in folder.Files
If Right(file.Name, 4) = "xlsx" Then
fileNames = fileNames & file.Name & ";" ' will give a list of all filenames
End If
Next
With Master_workbook.Worksheets("FBI")
lastRowY = .Cells(.Rows.Count, "AY").End(xlUp).Row
End With
For row = 2 to lastRowY
checkFile = Master_workbook.Worksheets("FBI").Range("AY").Value
If Instr(fileNames, checkFile) = 0 Then
Set newBook = Workbooks.Add
' do whatever with newBook
newBook.SaveAs (checkFile & ".xlsx")
newBook.Close
End If
Next
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句