|
楼主 |
发表于 2013-6-6 09:59
|
显示全部楼层
这是我的代码
Sub 资料生成()
Dim a(20) As String, i As Long, j As Long
With Sheets("填写页")
a(1) = .Cells(10, 4)
a(2) = .Cells(2, 4)
a(3) = .Cells(3, 4)
a(4) = .Cells(4, 4)
a(5) = .Cells(8, 4)
a(6) = .Cells(5, 4)
a(7) = .Cells(6, 4)
a(8) = .Cells(7, 4)
a(9) = .Cells(10, 4)
a(10) = .Cells(11, 4)
a(11) = .Cells(12, 4)
a(12) = .Cells(12, 5)
a(13) = .Cells(12, 6)
a(14) = .Cells(13, 4) & "," & .Cells(13, 5) & "," & .Cells(13, 6)
a(15) = .Cells(14, 4) & "," & .Cells(14, 5) & "," & .Cells(14, 6)
a(16) = .Cells(15, 4) & "," & .Cells(15, 5) & "," & .Cells(15, 6)
a(17) = .Cells(16, 4) & "," & .Cells(16, 5) & "," & .Cells(16, 6)
a(18) = .Cells(17, 4) & "," & .Cells(17, 5) & "," & .Cells(17, 6)
a(19) = .Cells(18, 4)
a(20) = .Cells(19, 4)
End With
r = Sheets("资料页").Range("b65535").End(xlUp).Row
If r > 6 Then
For i = 7 To r
If Sheets("资料页").Cells(i, 4) = Sheets("填写页").Cells(2, 4) Then
y = MsgBox("已有同名存在,是否添加?", 4)
If y = 6 Then GoTo 100
Exit Sub
End If
Next i
End If
100:
Sheets("资料页").Cells(r + 1, 2) = r - 6
For j = 3 To 21
Sheets("资料页").Cells(r + 1, j) = a(j - 1)
Next j
End Sub
|
|