求助将另一个工作表中子项目名称复制到该项目下方，谢谢

wangweihebtu

Qs18 发表于 2024-8-16 16:14
试试.............

感谢！您的图对着呢，好像您的附件传错了

ynzsvt

建议先对+的 全角半角进行统一替换。

Qs18

wangweihebtu 发表于 2024-8-16 16:52
感谢！您的图对着呢，好像您的附件传错了

哦，您觉得对把代码复制过去也可以的

songshihai

一样的活wps82秒,office110秒.所以到底谁更先进呢?

ynzsvt

咋这么慢的，我的代码秒出结果，只是运行前对+（）等进行全半角一致性替换处理。

chxw68

字典法，速度快一些。

gwjkkkkk

Option Explicit
Sub TEST7()
    Dim ar, br, vResult, i&, j&, r&, n&, t#
   
    Application.ScreenUpdating = False
    t = Timer
   
    ar = Worksheets(1).[A1].CurrentRegion.Value
    With Worksheets(2)
        r = .Cells(.Rows.Count, "A").End(xlUp).Row
        br = .Range("A1:A" & r)
    End With
    ReDim vResult(1 To UBound(ar) * 20, 1 To 3)
   
    r = 0
    With Worksheets(3)
        .Cells.Clear
        For i = 3 To UBound(ar)
            r = r + 1
            For j = 1 To 3
                vResult(r, j) = ar(i, j)
            Next j
            n = 0
            For j = 1 To UBound(br)
                If InStr(br(j, 1), ar(i, 3)) Then
                    n = n + 1
                    If n > 1 Then
                        r = r + 1: vResult(r, 3) = br(j, 1)
                    End If
                End If
            Next j
            .[A2].Resize(r, 3) = vResult
            .Activate
        Next i
    End With
   
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

请参考附件。。。

sunya_0529

WPS里的JSA练习一下——

songshihai

songshihai 发表于 2024-8-16 19:11
一样的活wps82秒,office110秒.所以到底谁更先进呢?

优化了一下,单元格循环改成了数组循环,直接给brr一个足够大的空间,避免了循环的时候频繁的redim brr