Excel 2013 年：从列中提取匹配数据

Question

我有大量以下格式的数据。

**M A Enterprises ~**
Member No: M-551/IV/A
Category: Food and vegetables
Year of Established: 1984
Address: Address line 1 
Address Line 2
Address Line 3
Address Line 4
Address Line 5
Phone: 11111111, 22222222
Fax: 33333333
Email: somemail@gmail.com
Website:www.somewebsite.com
Executive1: Mr. Ashok Kumar
Designation: Owner
Mobile: 9999999999
Executive2: Rahul Bhai
Designation: Director
Mobile: 3333333333
Product: food product processing
Rawmaterial: Ss Hot Rolled
**A B Enterprises ~**
Member No: M-552/IV/A
Category: Food and vegetables
Year of Established: 1984
Address: Address line 1 
Address Line 2
Address Line 3
Address Line 4
Address Line 5
Phone: 11111111, 22222222
Fax: 33333333
Email: somemail@gmail.com
Executive1: Mr. Ashok Kumar
Mobile: 9999999999
Executive2: Rahul Bhai
Mobile: 3333333333
Product: food product processing

如您所见，这里有2组数据。第一行是公司名称（粗体）。它没有 FIELD NAME，但公司名称后有一个尾随“~”和 space。

每组最多17个字段（公司名称、会员编号、类别等）。第二组只有 16 个字段（原始 material 不存在）

某些字段并非在每个集合中都存在，例如传真、名称、网站、电子邮件。

2套之间没有GAP（space，段落）。每个集合都以 "Product" 或 "Rawmaterial" 结尾。 "原始material 不是那么重要的信息，如果需要，我可以删除它。

地址行是灵活的，可以是 3 到 5 行，但在任何条目中都不能超过 6 或 7。

另一个问题是 "Designation"，它在某些条目中出现了 2 次。第一个在 "Executive1" 之后，第二个在 "Executive2" 之后。与 "Mobile".

相同

当前数据为纯文本格式，但我可以将其拉入 excel，并以“:”作为分隔符。此后将有 2 列，A1=会员编号和 B1=M-551/IV/A（依此类推），无法帮助输入公司名称，因为其中没有“：”符号。

那里有几千套，所以我无论如何都需要找到一种方法来做到这一点。

我想要实现的目标：

在Excel,

C1 - 公司名称（这是标题）
C2 - M A 企业
C3 - A B 企业

以此类推，一行一行，直到最后一组。

D1 - 会员号（这是标题）
D2 - M-551/IV/A
D3 - M-552/IV/A

等等...

其他字段同理

我尽力尝试了 VLookup、Match、Find 函数，但没有得到任何结果。

任何帮助都会很棒。谢谢

Answer 1

vba 下面的代码应该有所帮助。它是在“~”只会出现在公司名称中的假设下编写的。

Sub sTexttoExcel()

'Input File Path
filePath = "C:\CustomerData.txt"

Dim fso As FileSystemObject
Dim HeaderName() As String
Dim cellcontent As String
Dim CompanyDetails(2) As String
Dim RowCount, ColoumnCount As Integer
Set fso = New FileSystemObject
Set txtStream = fso.OpenTextFile(filePath, ForReading, False)

'Initialise Row and Column count
RowCount = 1
ColoumnCount = 1
coloumnheadercount = 0
RowHeaderCount = 0

'Loop through contents of text file to print headers
Do While Not txtStream.AtEndOfStream
    cellcontent = txtStream.ReadLine
    If InStr(1, cellcontent, "~", vbTextCompare) <> 0 Then
        'Print the header row
        RowHeaderCount = RowHeaderCount + 1
        coloumnheadercount = coloumnheadercount + 1
        If RowHeaderCount = 2 Then Exit Do
        Cells(1, coloumnheadercount) = "Company Name"
    ElseIf InStr(1, cellcontent, ":", vbTextCompare) <> 0 Then
        coloumnheadercount = coloumnheadercount + 1
        ReDim Preserve HeaderName(1 To coloumnheadercount)
        HeaderName(coloumnheadercount - 1) = Split(cellcontent, ":")(0)
        Cells(1, coloumnheadercount) = Split(cellcontent, ":")(0)
    End If
Loop
txtStream.Close

Set txtStream = fso.OpenTextFile(filePath, ForReading, False)
'Loop through contents of text file
Do While Not txtStream.AtEndOfStream
    cellcontent = txtStream.ReadLine

    'Store details of Executives in a seperate array
    If InStr(1, cellcontent, "Executive", vbTextCompare) <> 0 Then
        CompanyDetails(0) = cellcontent
    End If
    If InStr(1, cellcontent, "Designation", vbTextCompare) <> 0 Then
        CompanyDetails(1) = cellcontent
    End If
    If InStr(1, cellcontent, "Mobile", vbTextCompare) <> 0 Then
        CompanyDetails(2) = cellcontent
    End If

    'Check if it is a company name
    If InStr(1, cellcontent, "~", vbTextCompare) <> 0 Then
        RowCount = RowCount + 1
        ColoumnCount = 1
        Cells(RowCount, ColoumnCount) = cellcontent

    'Check if it has the text 'Address'
    ElseIf InStr(1, cellcontent, "Address", vbTextCompare) <> 0 Then
        If InStr(1, cellcontent, ":", vbTextCompare) <> 0 Then
            ColoumnCount = ColoumnCount + 1
            Cells(RowCount, ColoumnCount) = Cells(RowCount, ColoumnCount) & Trim(Split(cellcontent, ":")(1)) & vbCrLf
        Else
            Cells(RowCount, ColoumnCount) = Cells(RowCount, ColoumnCount) & cellcontent & vbCrLf
        End If

    'Check if it has the text 'Designation'
    ElseIf InStr(1, cellcontent, "Designation", vbTextCompare) <> 0 Then
        ColoumnCount = ColoumnCount + 1
        If InStr(1, CompanyDetails(0), "Executive1", vbTextCompare) <> 0 Then
            Call writeCell(cellcontent, RowCount, 11)
        ElseIf InStr(1, CompanyDetails(0), "Executive2", vbTextCompare) <> 0 Then
            Call writeCell(cellcontent, RowCount, 14)
        End If

    'Check if it has the text 'Mobile'
    ElseIf InStr(1, cellcontent, "Mobile", vbTextCompare) <> 0 Then
        ColoumnCount = ColoumnCount + 1
        If InStr(1, CompanyDetails(0), "Executive1", vbTextCompare) <> 0 Then
            Call writeCell(cellcontent, RowCount, 12)
        ElseIf InStr(1, CompanyDetails(0), "Executive2", vbTextCompare) <> 0 Then
            Call writeCell(cellcontent, RowCount, 15)
        End If

    Else
        ColoumnCount = ColoumnCount + 1
        For i = 1 To UBound(HeaderName) - 1
            If InStr(1, cellcontent, HeaderName(i), vbTextCompare) <> 0 Then Call writeCell(cellcontent, RowCount, i + 1)
        Next i
    End If

    Loop
txtStream.Close

End Sub

Sub writeCell(ByVal cellcontent As String, ByVal RowCount As Integer, ByVal ColoumnCount As Integer)
    Cells(RowCount, ColoumnCount) = Trim(Split(cellcontent, ":")(1))
End Sub

Excel 2013 年：从列中提取匹配数据

Excel 2013 : Pull Matching Data from Column

text

vlookup

excel-2013