|
Sub 插入行()
Application.ScreenUpdating = False
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:h" & r)
d(r + 1) = r + 1
For i = UBound(ar) To 2 Step -1
If ar(i, 5) <> "" Then
d(ar(i, 5)) = i
End If
Next i
x = d.keys
For i = 0 To UBound(x) - 1
kc = x(i)
xh = d(x(i))
.Rows(xh & ":" & xh + 1).Insert Shift:=xlDown
.Cells(xh, 3) = .Cells(xh - 1, 3)
.Cells(xh + 1, 3) = .Cells(xh - 1, 3)
Next i
End With
wb.Close True
End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub |
|