Question

情况：

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

我需要将所有文件中的所有工作表中的电子邮件地址合并为一个单一文本文件。

我正在计划

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

我到底怎么做呢？这些解决方案都是？任何人吗？

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

非常感谢！

Answer 1

以下一种方法可能是您所需要的90％（在vba中，因为它更容易测试！）

简而言之：

代码使用Dir打开strDir =“c：\ temp \”

xls

在该工作簿的每个工作表中找到真正的最后一个单元格以设置工作范围
代码循环遍历该范围的每一行，并过滤该列的一维数组以用于“@”
然后将过滤后的字符串写入csv文件

等等

[更新：现在的代码]

- 遍历行而不是列，避免了大小问题，输出现在按行匹配输入文件
- 使用工作簿和工作表名称

<强>码

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

End Sub

删除“不”包含某些文本的Excel列，或仅复制包含某些文本的单元格

1 个答案: