目的:根据用户选择复制满足一定条件的Excel行到另外一个行中。
注意红色的关键代码。
'把包含某一个数字的记录,
'全部复制到result 工作簿里
'用户选择的range范围
Sub findByNumber()
Dim rng As Range
Dim newrng As Range
Dim Tools As New Toolkit
Dim choice As Integer
Dim cell As Object
Dim rRow As Range
Dim inyes As Boolean
Dim realnumber As Integer
Dim name As String
Dim counter As Integer
inyes = False
On Error Resume Next
counter = 1
choice = Application.InputBox("输入包含的数字", "查找的数字", Type:=1)'必须为数字
Set rng = Application.InputBox("选择数据范围", "选择数据", Selection.Address, , , , , 8)
If rng Is Nothing Then
MsgBox "你没有选择数据,不能继续"
Exit Sub
End If
name = rng.Parent.name
Add_Sheet ("result")
realnumber = choice
Sheets(name).Activate
If realnumber = 0 Then
Else
On Error GoTo errorhandler
For Each rRow In rng.Rows
inyes = False
For Each cell In rRow.Cells
If cell.value = realnumber Then '行中某一列的值同用户输入的值相等,则该行复制到result
inyes = True
rRow.Copy
Sheets("result").Activate
Sheets("result").Cells(counter, 1).Select
Sheets("result").Paste
counter = counter + 1
Sheets(name).Activate
Exit For
End If
Next 'for
Next
End If
Sheets("result").Activate
Exit Sub
errorhandler:
MsgBox Err.Description & Err.Source
End Sub
星期四, 九月 28, 2006
星期二, 九月 26, 2006
Tips:Excel sort by Each Column of Row
1.Excel提供的按照 行 排序的功能,只能根据第一行,第一列来排序。
不能按照每一行第一列来排序。
必须自己编写一个方法来提供这个功能。
'iWhichWay as xlAscending 或 xlDescending,见Excel 2003 VBA 参考手册
Function SortRows(ByVal iWhichWay As Integer, rng As Range)
Dim rRow As Range
Dim parentSheet As String
parentSheet = rng.Parent.Name
Sheets(parentSheet).Activate '可以在任意sheet工作薄里对数据
'xlAscending,xlDescending
For Each rRow In rng.Rows
rRow.Sort Key1:=Range(rRow.Cells(1).Address), Order1:=iWhichWay , _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next
End Function
不能按照每一行第一列来排序。
必须自己编写一个方法来提供这个功能。
'iWhichWay as xlAscending 或 xlDescending,见Excel 2003 VBA 参考手册
Function SortRows(ByVal iWhichWay As Integer, rng As Range)
Dim rRow As Range
Dim parentSheet As String
parentSheet = rng.Parent.Name
Sheets(parentSheet).Activate '可以在任意sheet工作薄里对数据
'xlAscending,xlDescending
For Each rRow In rng.Rows
rRow.Sort Key1:=Range(rRow.Cells(1).Address), Order1:=iWhichWay , _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next
End Function
星期六, 九月 23, 2006
tips:excel vba 等待一段时间继续执行
方法 1: 使用空 For...Next 循环
对此方法缺点有是没有直接方法来确定准确的时间, 程序将运行循环量。 时间量取决于计算机的速度。 以下代码运行循环, 不起作用但占用时间。
Sub MyDelayMacro
For iCount = 1 to 1000
Next iCount
End Sub
方法 2: 使用 API 调用来暂停执行 Word
使用一个 API 调用来暂停执行 Word 用于固定的时间量。
Kernel32 包含函数, 暂停用于指定长的时间, 毫秒中指定程序的执行。 要使用函数, 必须首先在它将在其中使用模块的常规声明部分声明它:
Declare Sub Sleep Lib "kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long)
使用以下语法来调用 Sleep 函数:
Sub Sleep()
Sleep 1000 'Implements a 1 second delay
End Sub
方法 3: 使用 OnTime 方法
使用 OnTime 方法来设置长的时间以运行其他宏命令之前暂停。 OnTime 方法使用以下语法:
表达式 .OnTime 时, 名称, Tolerance)
由于 名称 名称 参数需要, 运行一个宏的名称, 必须创建两个宏。 第一个宏包含 OnTime 方法调用和其他命令与宏相关。 第二个宏分配时间已过时运行。 第二个宏可以是 " 虚设 " 宏执行什么。
本示例运行名为 15 秒从示例宏 (MyMainMacro) 运行时间为 " MyDelayMacro " 宏。
Sub MyMainMacro()
' Pause for 15 seconds.
Application.OnTime When:=Now + TimeValue("00:00:15"), _
Name:="MyDelayMacro"
End Sub
Public Sub MyDelayMacro()
' Place your delayed macro commands here.
MsgBox "This macro runs after 15 seconds."
End Sub
有关获取与 VisualBasic 帮助 VisualBasicforApplications, 请单击文章编号以查看 Microsoft 知识库中相应:
对此方法缺点有是没有直接方法来确定准确的时间, 程序将运行循环量。 时间量取决于计算机的速度。 以下代码运行循环, 不起作用但占用时间。
Sub MyDelayMacro
For iCount = 1 to 1000
Next iCount
End Sub
方法 2: 使用 API 调用来暂停执行 Word
使用一个 API 调用来暂停执行 Word 用于固定的时间量。
Kernel32 包含函数, 暂停用于指定长的时间, 毫秒中指定程序的执行。 要使用函数, 必须首先在它将在其中使用模块的常规声明部分声明它:
Declare Sub Sleep Lib "kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long)
使用以下语法来调用 Sleep 函数:
Sub Sleep()
Sleep 1000 'Implements a 1 second delay
End Sub
方法 3: 使用 OnTime 方法
使用 OnTime 方法来设置长的时间以运行其他宏命令之前暂停。 OnTime 方法使用以下语法:
表达式 .OnTime 时, 名称, Tolerance)
由于 名称 名称 参数需要, 运行一个宏的名称, 必须创建两个宏。 第一个宏包含 OnTime 方法调用和其他命令与宏相关。 第二个宏分配时间已过时运行。 第二个宏可以是 " 虚设 " 宏执行什么。
本示例运行名为 15 秒从示例宏 (MyMainMacro) 运行时间为 " MyDelayMacro " 宏。
Sub MyMainMacro()
' Pause for 15 seconds.
Application.OnTime When:=Now + TimeValue("00:00:15"), _
Name:="MyDelayMacro"
End Sub
Public Sub MyDelayMacro()
' Place your delayed macro commands here.
MsgBox "This macro runs after 15 seconds."
End Sub
有关获取与 VisualBasic 帮助 VisualBasicforApplications, 请单击文章编号以查看 Microsoft 知识库中相应:
星期五, 九月 22, 2006
Tips:Excel添加新的worksheet
1.添加新的worksheet并检查是否存在,如果存在,则清楚里面的所有数据。
Sub Add_Sheet(shtName As String)
Dim wSht As Worksheet
For Each wSht In Worksheets
If wSht.Name = shtName Then
Sheets(shtName).Cells.Clear '清除所有数据
Sheets(shtName).Activate 'focus
Exit Sub
End If
' MsgBox ActiveSheet.Name
Next wSht
Sheets.Add.Name = shtName
Sheets(shtName).Move After:=Sheets(Sheets.Count)
End Sub
Sub Add_Sheet(shtName As String)
Dim wSht As Worksheet
For Each wSht In Worksheets
If wSht.Name = shtName Then
Sheets(shtName).Cells.Clear '清除所有数据
Sheets(shtName).Activate 'focus
Exit Sub
End If
' MsgBox ActiveSheet.Name
Next wSht
Sheets.Add.Name = shtName
Sheets(shtName).Move After:=Sheets(Sheets.Count)
End Sub
星期四, 九月 21, 2006
tips:遍历(Iterator)Excel Range的数据。
方法一:
For i = 1 To rng.row
For j=1 to rng.column
cells(i,j).value=??.
Next
counter = 1
For Each cell In rng
Cells(21, counter).Value = cell.Value
counter = counter + 1
Next
For i = 1 To rng.row
For j=1 to rng.column
cells(i,j).value=??.
Next
counter = 1
For Each cell In rng
Cells(21, counter).Value = cell.Value
counter = counter + 1
Next
星期三, 九月 20, 2006
Excel Developer Tip: Pausing a Macro to Get a User-Selected Range
目的,停止宏运行,然后让用户选择某个范围的数据range
Sub ProblemCode()
Dim oRangeSelected As Range
On Error Resume Next
Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
"SelectARAnge Demo", Selection.Address, , , , , 8)
If oRangeSelected Is Nothing Then
MsgBox "It appears as if you pressed cancel!"
Else
MsgBox "You selected: " & oRangeSelected.Address(external:=True)
End If
End Sub
这里的inpubox可以改变为一个editor,如果标准Excel显示。
星期五, 九月 08, 2006
开源的数学工具包。
1. Scilab http://www.scilab.org/ 最著名的开源数据包,提供很多语言的接口。
http://jscience.org/ 是个提供一些数学方法的 java mathematics library
提供全部数学方法的函数库非常之少。
遗憾。
http://jscience.org/ 是个提供一些数学方法的 java mathematics library
提供全部数学方法的函数库非常之少。
遗憾。
订阅:
博文 (Atom)