oobird

改這樣會快得多
Sub pp()
   
    Dim mSht As Worksheet
    Dim d As Object, arr
    Dim s%, m%, r%
    Dim mRng
    Set d = CreateObject("Scripting.Dictionary")
    Set mSht = Worksheets("Test")
    With mSht
        mRng = .Range("a1:g10988")
        r = UBound(mRng, 1)
        
        For s = 1 To r
arr = Array(mRng(s, 1), mRng(s, 2), mRng(s, 3), mRng(s, 4), mRng(s, 5), mRng(s, 6), mRng(s, 7))
MyCom = Join(arr)
d(s) = MyCom
           
        Next
       .Range("h1").Resize(r) = Application.Transpose(d.items)
       .Range("h1") = "合併簽審"
        
    End With
End Sub