满足条件导出数据的问题，请各位进来看看！谢谢！

hmc530

例子.rar (55.55 KB, 下载次数: 11)

2022-11-17 15:37 上传

点击文件名下载附件

笨鸟飞不高

例子.zip (72.35 KB, 下载次数: 5)

2022-11-17 16:52 上传

点击文件名下载附件

zxsea_7426

hmc530

zxsea_7426 发表于 2022-11-17 16:52

为什么我吧A5:G的数据清空后，再更新A4:G4内容就清空了啊

hmc530

笨鸟飞不高 发表于 2022-11-17 16:27

提取的内容不对啊

nihao123456789

我也做了一个

gwjkkkkk

Sub TEST()
    Dim arr, vData, i&, j&, R&, iRow&
    arr = Range("N3", Cells(Rows.Count, "AL").End(xlUp))
    [A1].CurrentRegion.Offset(4).ClearContents
    vData = [A1].CurrentRegion.Resize(10000): R = 4
    For i = 3 To UBound(arr)
       For j = 4 To UBound(arr, 2) Step 3
         If arr(i, j) = "满柜" Then
            R = R + 1: vData(R, 7) = "满柜"
            vData(R, 1) = R - 4: vData(R, 2) = Format(Now(), "m月d日")
            vData(R, 3) = arr(1, j - 2): vData(R, 4) = arr(i, 1)
            vData(R, 5) = arr(i, j - 2): vData(R, 6) = arr(i, j - 1)
         End If
       Next j
    Next i
    [A1].Resize(R, UBound(vData, 2)) = vData
    Beep
End Sub

gwjkkkkk

参与一下。。。

zxsea_7426

hmc530 发表于 2022-11-17 17:06
为什么我吧A5:G的数据清空后，再更新A4:G4内容就清空了啊

笨鸟飞不高

hmc530 发表于 2022-11-17 17:07
提取的内容不对啊

Sub AwTest()
    Dim i&, j%, k%, r&, xh%, qh%, arr, brr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    arr = Range("N3:AL" & Cells(Rows.Count, "N").End(3).Row)
    For i = 3 To UBound(arr)
        For j = 2 To UBound(arr, 2) Step 3
            If arr(i, j + 2) = "满柜" Then d(i - 2 & "|" & j) = ""
        Next
    Next
    ReDim crr(1 To d.Count, 1 To 7)
    If Cells(Rows.Count, 1).End(3).Row > 4 Then
        brr = Range("A5:G" & Cells(Rows.Count, 1).End(3).Row)
        For i = 1 To UBound(brr)
            k = Val(Split(brr(i, 3), "第")(1))
            If d.Exists(brr(i, 4) & "|" & k * 3 - 1) Then
                r = r + 1: crr(r, 1) = r
                For j = 2 To UBound(brr, 2)
                    crr(r, j) = brr(i, j)
                Next
                d.Remove brr(i, 4) & "|" & k * 3 - 1
            End If
        Next
    End If
    If d.Count Then
        For i = 1 To d.Count
            r = r + 1: crr(r, 1) = r: crr(r, 2) = Date
            xh = Split(d.Keys()(i - 1), "|")(0)
            qh = Split(d.Keys()(i - 1), "|")(1)
            For k = 0 To 2
                crr(r, 5 + k) = arr(xh + 2, qh + k)
            Next
            crr(r, 3) = "第" & (qh + 1) / 3 & "区"
            crr(r, 4) = xh
        Next
    End If
    If r Then
        [A5:G500] = ""
        [A5].Resize(r, UBound(crr, 2)) = crr
    End If
End Sub