多订单数据提取求助

猕猴桃一身毛

各位大佬，同一表格里有多份订单，现需提取其中部分数据整理。其中客户和单据号可以用filter提取，但是产品部分的数据有办法快速提取吗？

3190496160

Sub 数据整理()
Dim ar As Variant
Dim br(), cr()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:g" & r)
End With
ReDim br(1 To UBound(ar), 1 To 2)
For i = 3 To UBound(ar)
    If InStr(ar(i, 6), "单据号") > 0 Then
        n = n + 1
        br(n, 1) = i
    End If
    If InStr(ar(i, 1), "制单人") > 0 Then
        br(n, 2) = i - 1
    End If
Next i
ReDim cr(1 To UBound(ar), 1 To 8)
For i = 1 To n
    ks = br(i, 1)
    js = br(i, 2)
    For s = ks + 7 To js
        If ar(s, 1) <> "" Then
            If IsNumeric(ar(s, 1)) Then
                m = m + 1
                cr(m, 1) = ar(ks + 1, 4)
                cr(m, 2) = ar(ks, 7)
                For j = 2 To 7
                    cr(m, j + 1) = ar(s, j)
                Next j
            End If
        End If
    Next s
Next i
With Sheets("结果")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(m, UBound(cr, 2)) = cr
End With
MsgBox "ok!"
End Sub

3190496160

订单数据提取求助.rar (24.97 KB, 下载次数: 1)

2024-3-27 17:56 上传

点击文件名下载附件

jisijie630

=OFFSET(B1,MATCH($J$10,$G:$G,)+6,)

下拉右拉。

猕猴桃一身毛

3190496160 发表于 2024-3-27 17:55
Sub 数据整理()
Dim ar As Variant
Dim br(), cr()

感动又感谢~

猕猴桃一身毛

3190496160 发表于 2024-3-27 17:55
Sub 数据整理()
Dim ar As Variant
Dim br(), cr()

感动又感谢~