作者minejel (活着看历史)
看板CodeJob
标题Re: [发案] 需要一个软体 按键精灵也做得来
时间Mon Nov 21 00:54:34 2011
excel 内新增一个巨集按钮
'下面是程式码,功能就是简单地把两行转成一行
Dim o_sheet '原本资料的工作表名称
Dim n_sheet '整合後的资料表名称
Dim s_range '资料的左上起始位置 ex:A1
Dim e_range '资料的右下结束位置 ex:B6
Dim count '计数
Sub 按钮1_Click()
o_sheet = "工作表1"
s_range = "A1"
e_range = "B6"
count = 0
Sheets.Add After:=Sheets(Sheets.count)
Sheets(Sheets.count).Select
n_sheet = Sheets(Sheets.count).Name
If Mid(s_range, 1, 1) <> Mid(e_range, 1, 1) Then
If Mid(s_range, 2) <= Mid(e_range, 2) Then
For i = Mid(s_range, 2) To Mid(e_range, 2)
count = count + 1
Sheets(o_sheet).Select
Range(Mid(s_range, 1, 1) & i).Select
Selection.Copy
Sheets(n_sheet).Select
Range("A" & count).Select
ActiveSheet.Paste
'判断e_range的资料,复制贴入下一行
If Mid(s_range, 2) <= Mid(e_range, 2) Then
count = count + 1
Sheets(o_sheet).Select
Range(Mid(e_range, 1, 1) & i).Select
Selection.Copy
Sheets(n_sheet).Select
Range("A" & count).Select
ActiveSheet.Paste
End If
Next
End If
End If
'把结果复制到剪贴簿
Sheets(n_sheet).Select
Range("A1:A" & count).Select
Selection.Copy
End Sub
要更改的地方只有
o_sheet = "工作表1" <--你资料的工作表名称
s_range = "A1" <--起始
e_range = "B6" <--结束
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 1.170.135.10
※ 编辑: minejel 来自: 1.170.135.10 (11/21 00:55)
※ 编辑: minejel 来自: 1.170.135.10 (11/21 00:55)
1F：推 phi12345:推~专业!!! 11/21 03:43