Question

下面的代码不会向文本文件写入任何内容，也不会出现错误。我正在尝试获取一列excel数据并放入一个数组。然后取另一列数据并将其放入数组中。第一列包含名称，第二列包含值。我正在尝试获取匹配的所有名称，并查看值是否也匹配。

示例：

第1栏：............................................ .........................................第2栏：

John                                              1/2/2013
John                                              1/2/2013
George                                            1/2/2013
George                                            7/14/2013
George                                            6/2/2013
Connor                                            5/1/2013
Connor                                            5/1/2013
Connor                                            6/19/2013

我想写入文本文件的输出是：

John                                              1/2/2013
John                                              1/2/2013
Connor                                            5/1/2013
Connor                                            5/1/2013

我到目前为止的代码：

Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim Appx, Bookx, shiftx 
Dim filename, value1, value2, value3, value4

filename = "c:\finRate.xls"

Set Appx = CreateObject("Excel.Application")
set Bookx = Appx.WorkBooks.Open(filename)
set shiftx = Appx.activesheet

value1 = shiftx.Cells(2, 1)
value2 = shiftx.Cells(2, 2)
Worksheets("Sheet1").Range("A1:A5000").FormulaArray = value3
Worksheets("Sheet1").Range("B1:B5000").FormulaArray = value4

Set objFile = objFSO.OpenTextFile("C:\Users\A352592\Desktop\predata1.txt", ForReading)
objFile.writeline value3
Set objFile = objFSO.OpenTextFile("C:\Users\A352592\Desktop\predata2.txt", ForReading)
objFile.writeline value4
Set objOutputFile = objFSO.OpenTextFile("C:\Users\A352592\Desktop\Noduplicates.txt", 2, True)
Set objOutputFile2 = objFSO.OpenTextFile("C:\Users\A352592\Desktop\Duplicates.txt", 2, True)
Set objOutputFile3 = objFSO.OpenTextFile("C:\Users\A352592\Desktop\alone.txt", 2, True)
Set Dict = CreateObject("Scripting.Dictionary")


xlBook.Close False
Appx.Quit


set shiftx = Nothing
Set Bookx = Nothing
Set Appx = Nothing 


Do until objFile.atEndOfStream
    strCurrentLine = objFile.ReadLine
    If not Dict.Exists(strCurrentLine) then 
        objOutputFile.WriteLine strCurrentLine
        Dict.Add strCurrentLine,strCurrentLine
    ElseIf Dict.Exists(strCurrentLine) then 
        objOutputFile2.WriteLine strCurrentLine

    Else
        objOutputFile3.WriteLine strCurrentLine
    End if 
Loop
wscript.echo "Finished"

Answer 1

您是否确实需要所有重复的行，或者一个唯一的重复列表是否足够？后者可以通过工作表ADO query实现：

filename = "C:\path\to\your.xlsx"

Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
          ";Extended Properties=""Excel 12.0;IMEX=1;HDR=Yes;"""

Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT [Name],[Date] FROM [Sheet1$] " & _
        "GROUP BY [Name],[Date] HAVING Count([Name]) > 1"

Do Until rs.EOF
  WScript.Echo rs.Fields(0).Value & vbTab & rs.Fields(1).Value
  rs.MoveNext
Loop

rs.Close
conn.Close

根据需要调整工作表和列标题的名称。

请注意，在64位系统上，您需要使用32位VBScript解释器（来自C:\Windows\SysWOW64）运行此代码。

如何将excel列输入到数组中并比较两个数组

1 个答案: