如何批量处理附件数据

亦草人

请教：附件中源数据有些是3行，有些是4行，如何批量处理成目标格式？谢谢

solextrade

数组公式右拖下拖，D3
=IFERROR(VLOOKUP(D$2,OFFSET($A$2:$B$2,SMALL(IF($A$3:$A$24=1,ROW($1:$22)),ROW(A1)),,4),2,),"")

亦草人

这个公式是基于A列有编号的情况下，数据量大的话给A列加编号很繁琐，如何实现只有B列源数据，得到目标格式？

静看流年RSSQ

亦草人 发表于 2020-1-10 17:07
这个公式是基于A列有编号的情况下，数据量大的话给A列加编号很繁琐，如何实现只有B列源数据，得到目标格式 ...

那么如何判断    到底是拆成3  还是 4    总得有规律吧。

有规律函数也不好整。目测是有电话号码的是4  没有的就是3   

建议到VBA去碰碰运气。

亦草人

源数据是一些公司信息列表，前三行分别是公司名称、地址、类别，有些有电话号码的就是4行，没有电话号码的就是3行

1055751654

静看流年RSSQ 发表于 2020-1-10 17:14
那么如何判断    到底是拆成3  还是 4    总得有规律吧。

有规律函数也不好整。目测是有电话号码的是4 ...

Option Explicit
Sub VBA()
Dim d, arr, i%, q, w, e, r, n, arr1(1 To 1000, 1 To 10000), rng
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
arr = Range("A1:B" & [b1048576].End(xlUp).Row)
For i = 3 To UBound(arr)
    If Not d.exists(arr(i, 1)) Then
        d(arr(i, 1)) = arr(i, 2)
            Else
        d(arr(i, 1)) = d(arr(i, 1)) & "|" & arr(i, 2)
    End If
Next
For q = 0 To d.Count - 1
w = Split(d.items()(q), "|")
For r = 1 To UBound(w) + 1
e = Application.Index(Split(d.items()(q), "|"), r)
n = 0
For Each rng In d.keys
n = n + 1
arr1(1, n) = rng
Next
arr1(r + 1, q + 1) = e
Next
[D2].Resize(r + 1, q + 1) = arr1
Next
Set d = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "OK，完成！！！", 48, "温馨提示……"
End Sub