1

情况：

  • 我有数百个 excel 文件（.xls和.xlsx）；
  • 这些文件中的每一个都包含多个工作表；
  • 这些表格中的每一个都有多列信息（在这种情况下，是联系方式）。
  • 但是，所有文件（甚至任何文件中的任何工作表）的格式都不相同（例如，有时电子邮件地址可能在 J 列中，有时在 A 列或 D 列中，等等；有时它会被标记为“电子邮件”，有时它会被标记为“电子邮件地址”，有时它根本没有标签）。

我需要将所有文件中所有工作表中的电子邮件地址放入一个单独的文本文件中。

我正计划

  1. 删除所有不包含电子邮件地址的列（即所有不包含“@”的列），然后将每个文件中的每个工作表转换为 csv/txt 文件。
  2. 或从每个文件的每张纸中复制包含“@”的每个单元格并将其粘贴到一个 csv/txt 文件中。

我到底要怎么做呢？这些解决方案中的任何一个？任何人？

（注意：所有的 excel 文件都位于同一个文件夹中）

非常感谢！

4

1 回答 1

2

这是一种可能是您需要的 90% 的方法（在中，因为它更容易测试！）

简而言之：

  1. 该代码用于Dir打开= "c:\temp\"下的每个xls * 文件strDir
  2. 在该工作簿的每个工作表中找到真正的最后一个单元格以设置工作范围
  3. 代码循环遍历该范围的每一行，并为“@”过滤该列的一维数组
  4. 然后将过滤后的字符串写入文件

等等

[更新：现在的代码]

- 循环通过行而不是列，这避免了大小问题，并且输出现在按行匹配输入文件
- 在电子邮件列表转储前加上工作簿和工作表名称

代码

Sub GetEm()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim strFile As String
Dim strEmail As String
Dim strDir As String
Dim strFiltered As String
Dim objFSO As Object
Dim objTF As Object

With Application
    lngcalc = .Calculation
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set objFSO = CreateObject("scripting.filesystemobject")

strDir = "c:\tmp\"
strFile = Dir(strDir & "*.xls*")
Set objTF = objFSO.createtextfile(strDir & "output.csv", 2)

Do While Len(strFile) > 0
    Set wb = Workbooks.Open(strDir & strFile, False)
    For Each ws In wb.Sheets
        Set rng1 = ws.Cells.Find("*", ws.[a1], xlFormulas, , xlByRows, xlPrevious)
         'avoid blank sheets
        If Not rng1 Is Nothing Then
            Set rng2 = ws.Cells.Find("*", ws.[a1], xlFormulas, , xlByColumns, xlPrevious)
            Set rng2 = ws.Range(ws.[a1], ws.Cells(rng1.Row, rng2.Column))
            'avoid array errors on sheets with data only in A1
            If rng2.Columns.Count = 1 Then Set rng2 = rng2.Resize(rng2.Rows.Count, 2)
            For Each rng3 In rng2.Rows
            strFiltered = Join(Filter(Application.Transpose(Application.Transpose(rng3)), "@"), ",")
                If Len(strFiltered) > 0 Then
                objTF.writeline (wb.Name & "," & ws.Name & ",") & strFiltered
                End If
            Next
        End If
    Next
    wb.Close False
    strFile = Dir
Loop

Set wb = Workbooks.Open(strDir & "output.csv", False)
wb.Sheets(1).Columns.AutoFit

With Application
    .Calculation = lngcalc
    .EnableEvents = True
    .ScreenUpdating = True
End With

结束子

于 2012-11-14T12:03:33.507 回答