VBA怎么将A列数据按条件分多列

姚阿福

怎么将“源数据”表中A列数据，按“说明”表的要求，转录到“中转”表

源数据按以下条件录入到中转表中的各列
建议先删除所有 ...more 所在行
将“丨*”替换成“”（丨后面字符都替换成空值）
再识别 user name 作为条件，根据行数分别按条件录入

陆离Lowry

眼花缭乱，好歹给个模拟结果

准提部林

就附件案例//
Xl0000418.rar (121.38 KB, 下载次数: 13)

2023-1-29 12:43 上传

点击文件名下载附件

3190496160

Sub 数据整理()
Application.ScreenUpdating = False
Dim ar As Variant
With Sheets("源数据")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 3 Then MsgBox "源数据为空！": End
    ar = .Range("a4:a" & r)
End With
Dim br()
ReDim br(1 To UBound(ar) * 50, 1 To 5)
For i = 1 To UBound(ar) Step 1
    If InStr(ar(i, 1), "User Name:") > 0 Then
        rr = Split(Split(ar(i + 4, 1), ":")(1), "|")
        For s = 0 To UBound(rr)
            If Trim(rr(s)) <> "" Then
                n = n + 1
                If InStr(ar(i + 6, 1), "... More") > 0 Then
                    br(n, 1) = ar(i + 7, 1)
                Else
                    br(n, 1) = ar(i + 6, 1)
                End If
                br(n, 2) = ar(i + 1, 1)
                br(n, 3) = Split(ar(i + 2, 1), ":")(1)
                br(n, 4) = rr(s)
            End If
        Next s
    End If
Next i
With Sheets("中转")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(n, 5) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

A列数据按条件分多列.rar (125.83 KB, 下载次数: 5)

2023-1-29 13:06 上传

点击文件名下载附件

3190496160

代码是猜着写的，仅供参考，e列实在是不知道要提取什么

姚阿福

3190496160 发表于 2023-1-29 13:07
代码是猜着写的，仅供参考，e列实在是不知道要提取什么

非常感谢，我没说清楚，E列要提取每个重复字段的“本行代表用户评论，没有固定字符区分，需要录入-001”这一行数据

姚阿福

准提部林 发表于 2023-1-29 12:43
就附件案例//

非常感谢，是我想要的效果，我先学习一下

grf1973

在四楼的基础上改的。找到日期行后直接把循环数放到日期行。

姚阿福

grf1973 发表于 2023-1-29 13:53
在四楼的基础上改的。找到日期行后直接把循环数放到日期行。

非常感谢，
“本行代表用户评论，没有固定字符区分，需要录入-001”这个字段是原文被我替换掉了，直接整个写入就行。

Sub 数据整理()
    ar = Sheets("源数据").[a1].CurrentRegion
    ReDim br(1 To UBound(ar) / 7, 1 To 5)
    For i = 4 To UBound(ar)
        If InStr(ar(i, 1), "User Name:") > 0 Then
            n = n + 1
            t = IIf(InStr(ar(i + 6, 1), "... More") > 0, 7, 6)
            br(n, 1) = ar(i + t, 1)
            br(n, 2) = ar(i + 1, 1)
            br(n, 3) = Mid(ar(i + 2, 1), 10)
            br(n, 4) = Split(Mid(ar(i + 4, 1), 11), "|")(0)
            br(n, 5) = ar(i + 5, 1)
            i = i + t
       End If
    Next i
    With Sheets("中转")
        .[a1].CurrentRegion.Offset(1) = Empty
        .[a2].Resize(n, 5) = br
    End With
End Sub