如何查找并替换多行内容

翁知江安

Dim i, j, k, m, n, p, irow, irow1
Dim ar, br
irow = Sheet1.[b65536].End(xlUp).Row
ar = Sheet1.Range("a1:c" & irow)
irow1 = Sheet1.[e65536].End(xlUp).Row
br = Sheet1.Range("e1:f" & irow1)
  m = 1
For i = 2 To irow
   If ar(i, 1) = "离职" Then
     If UBound(br) >= m + 1 Then
     m = m + 1
     ar(i, 1) = "": ar(i, 2) = br(m, 1): ar(i, 3) = br(m, 2)
     br(m, 1) = "": br(m, 2) = ""
     Else
     ar(i, 1) = "": ar(i, 2) = "": ar(i, 3) = ""
     End If
  End If
Next
ReDim cr(1 To irow, 1 To 3)
For j = 1 To irow
   If ar(j, 2) <> "" Then
   k = k + 1
   For p = 1 To 3
   cr(k, p) = ar(j, p)
   Next
   End If
Next
ReDim dr(1 To irow, 1 To 2)
  For j = 2 To irow1
    If br(j, 1) <> "" Then
    n = n + 1
    For p = 1 To 2
    dr(n, p) = br(j, p)
    Next
    End If
   Next
Sheet2.[a1].Resize(100, 3).ClearContents
Sheet2.[a1].Resize(k, 3) = cr
If n > 0 Then
Sheet2.Cells(k + 1, 2).Resize(n, 2) = dr
End If
End Sub

翁知江安

在编写过程中，适当对原始数据进行了拓展，希望对您有所帮助