紧急求救关于vb操作excel问题!!100分重谢,可以加分!
A
1【题 名】论树立科学发展观，提升企业技术创新能力
2【作 者】黄海
3【机 构】不详
4【刊 名】交通世界.2006(10B).-78-79
5
6
7
8
9【题 名】畜牧业发展与科学技术
10【作 者】段诚中
11【机 构】四川省畜牧科学研究院研究员
12【刊 名】农村养殖技术.2006(18).-5-5
13
14
15
16
17【题 名】加快技术创新步伐 振兴纺织机械制造业
18【作 者】无
19【机 构】中国纺织机械器材工业协会,100742
20【刊 名】纺织机械.2006(5).-2-9
如上所写,在A列中,有2000多个这样的格式数据
现在的目的是想把A列数据通过vba或函数,提取数据成为按列拆分.
b c d e
题名 作者 机构 刊名
论树立科学... 黄海 不详 交通世界.2006(10B).-78-79
畜牧业发展与科学技术 段诚中 四川省畜牧科学研究院研究员 农村养殖技术.2006(18).-5-5
各位大哥怎么实现.跪地求,项目紧!!
[解决办法]
请把此文件发送至fengjj@d-03.com 我帮你转换。
[解决办法]
Public Sub 数据整理()
Dim sh1 As Worksheet '原始数据表
Dim sh2 As Worksheet '结果输出表
Dim m As Long
Dim n As Long
Set sh1 = Worksheets(1)
Set sh2 = Worksheets(2)
m = 1
n = 0
Do
sh2.Cells(m, 1) = sh1.Cells(n + 1, 1)
sh2.Cells(m, 2) = sh1.Cells(n + 2, 1)
sh2.Cells(m, 3) = sh1.Cells(n + 3, 1)
sh2.Cells(m, 4) = sh1.Cells(n + 4, 1)
n = 8 * m
m = m + 1
Loop Until sh1.Cells(n, 1) = "" And sh1.Cells(n + 4, 1) = ""
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
[解决办法]
- VBScript code
Option ExplicitPrivate Sub Command1_Click() Dim a() As String, i As Long, j As Long, maxl As Long, Cl As Long Dim ep As Excel.Application Dim eb As Excel.Workbook Dim es As Excel.Worksheet Set ep = CreateObject("Excel.Application") Set eb = ep.Workbooks.Open("e:\test.xls") '这里文件名路径自己修改下 Set es = eb.Sheets(1) On Error Resume Next maxl = Val(InputBox("请输入最大行数")) Cl = 2 With es .Cells(1, 2) = "题名" .Cells(1, 3) = "作者" .Cells(1, 4) = "机构" .Cells(1, 5) = "刊名" For i = 1 To maxl Step 8 For j = 0 To 3 a = Split(.Cells(i + j, 1), "】") .Cells(Cl, j + 2) = a(1) Next Cl = Cl + 1 Next End With eb.Save Set es = Nothing eb.Close Set eb = Nothing ep.Quit Set ep = NothingEnd Sub
[解决办法]
别忘记引用microsoft excel