credit to http://demos.telerik.com/aspnet-ajax/controls/examples/integration/chartandtooltip/defaultcs.aspx?product=chart
| Operator | Action |
| = | Equal To |
| < > | Not Equal To |
| < | Less Than |
| > | Greater Than |
| <= | Less Than or Equal To |
| >= | Greater Than or Equal To |
#!/usr/bin/perl
use strict;
my $data = '2323424: 2434324, 3455543543';
my @ftr =();
my @values = ();
@values = split(/(\d+)/, $data);
foreach my $val (0 .. $#values) {
unless ( $values[$val] =~/^[0-9]+$/)
{
splice(@values, $val, 1);
}
}
print " @values\n";
exit 0;
Good post for beginner:
http://www.perlmonks.org/?node_id=44536
Website to download apache : httpd-2.0.64-win32-x86-openssl-0.9.8o.msi
http://httpd.apache.org/download.cgi#apache24
好好听噢~~
丁噹
不是你的錯
popular module :- spreadsheet::ParseExcel
http://search.cpan.org/~jmcnamara/Spreadsheet-ParseExcel-0.59/lib/Spreadsheet/ParseExcel.pm
http://cpan.uwinnipeg.ca/htdocs/Spreadsheet-WriteExcel/INSTALL.html
In this workboook:
my @num = qw (1 2 3 4 5); my @alp = qw (A B C D E); #One way for my $index (0 .. $#num) { print "$num[$index]-$alp[$index]\n"; } #Or print "$num[$_]-$alp[$_]\n" for (0 .. $#num);
Sub DeleteHiddenRows_Workbook() 'This Microsoft Excel Macro will remove hidden rows from End Sub
'all worksheets in a workbook.
For i = 1 To Worksheets.Count
If Worksheets(i).Visible Then
Worksheets(i).Select
ActiveCell.SpecialCells(xlLastCell).Select
k = ActiveCell.Row
For j = 1 To k
If Rows(j).Hidden Then
Rows(j).Hidden = False
Rows(j).Delete
End If
Next j
End If
Next i
If Worksheets(1).Visible Then Worksheets(1).Select
Range(“A1″).ColumnWidth = 0 Or Range(“A1″).RowHeight = 0
Range(“A1″).EntireColumn.Hidden Or Range(“A1″).EntireRow.Hidden
method 1:
Private Sub Worksheet_Activate()
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=847)
Ctrl.Enabled = False
Next Ctrl
End Sub
Private Sub Worksheet_Deactivate()
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=847)
Ctrl.Enabled = True
Next Ctrl
End Sub
----------------------------------------------------------------------------------------------------------------
Method 2:
Option Explicit
Private Sub Workbook_Activate()
Call Workbook_SheetActivate(ActiveSheet)
End Sub
Private Sub Workbook_Deactivate()
Call Indel
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ActiveSheet.Name = ("Data") _
Or ActiveSheet.Name = ("Query") _
Or ActiveSheet.Name = ("Sheet1") Then
Outdel
Else
Indel
End If
Next ws
End Sub
Private Sub Outdel()
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=847)
Ctrl.Enabled = False
Next Ctrl
End Sub
Private Sub Indel()
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=847)
Ctrl.Enabled = True
Next Ctrl
End Sub
----------------------------------------------------------------------------------------------------------------
Method 3:
Private Sub Worksheet_Activate()
Dim CB As CommandBar
Dim Ctrl As CommandBarControl
For Each CB In Application.CommandBars
Set Ctrl = CB.FindControl(ID:=847, recursive:=True)
If Not Ctrl Is Nothing Then
Ctrl.OnAction = "RefuseToDelete"
Ctrl.State = msoButtonUp
End If
Next
End Sub
Private Sub Worksheet_Deactivate()
Dim CB As CommandBar
Dim Ctrl As CommandBarControl
For Each CB In Application.CommandBars
Set Ctrl = CB.FindControl(ID:=847, recursive:=True)
If Not Ctrl Is Nothing Then Ctrl.OnAction = ""
Next
End Sub
Private Sub ResetDelete()
Dim CB As CommandBar
Dim Ctrl As CommandBarControl
For Each CB In Application.CommandBars
Set Ctrl = CB.FindControl(ID:=847, recursive:=True)
If Not Ctrl Is Nothing Then
Ctrl.Reset
Next CB
End Sub
'put in standard module
Public Sub RefuseToDelete()
MsgBox "This worksheet should not be deleted!", _
Buttons:=vbExclamation, _
Title:="Cannot Deleteworksheet!"
End Sub
myint=instr(1,activecell.value,"Abc")
which is going to return a number to where "Abc" starts
if myint > 0
text found.
----------------------------------------------------------------------
Function TextSearch(ByVal strSearchFor, ByVal Target As Variant) As Boolean
Dim OneCell As Range
TextSearch = False
If TypeName(Target) = "Range" Then
For Each OneCell In Target
If InStr(1, OneCell.Text, strSearchFor, vbTextCompare) > 0 Then
TextSearch = True
Exit For
End if
Next OneCell
ElseIf TypeName(Target) = "String" Then
If InStr(1, Target, strSearchFor, vbTextCompare) > 0 Then TextSearch = True
End If
End Function
------------------------------------------------------------------------------
http://www.ozgrid.com/forum/showthread.php?t=115687
Option Explicit
Sub Bold1stWord()
Dim rCell As Range
With Selection
.Cells.Copy
.Cells.PasteSpecial xlValues
Application.CutCopyMode = False
For Each rCell In .Cells
rCell.Characters(1, InStr(1, rCell, ":") - 1).Font.Bold = True
Next rCell
End With
End Sub
http://www.teachexcel.com/free-excel-macros/m-138,udf-get-first-word-cell-excel-free-macro.html
Function GETFIRSTWORD(Text As String, Optional Separator As Variant)
Dim firstword As String
If IsMissing(Separator) Then
Separator = " "
End If
firstword = Left(Text, InStr(1, Text, Separator, vbTextCompare))
GETFIRSTWORD = Replace(firstword, Separator, "")
End Function
http://spreadsheetpage.com/index.php/file/C36/P20/
http://spreadsheetpage.com/index.php/files
- spreadsheet page with different macro and VB program, userform
http://spreadsheetpage.com/index.php/tip/C29
http://spreadsheetpage.com/index.php/tip/displaying_a_menu_of_worksheets_to_print/
tips
http://spreadsheetpage.com/index.php/tips
Sub FindKVV()
'
' FindKVV Macro
' Macro recorded 01-10-2003 by Neale Blackwood
'
Dim FirstRow
Dim FirstColumn
Columns("E:E").Select
Selection.Find(What:="KVV", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
FirstRow = ActiveCell.Row
FirstColumn = ActiveCell.Column
MsgBox "The Row is " & FirstRow & " the column number is " & FirstColumn
End Sub
Sub mother()
Dim lr As Long, sh As Worksheet, rng As Range
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For i = lr To 2 Step -1
If InStr(sh.Cells(i, 1), "mother") > 0 And _
InStr(sh.Cells(i-1, 1), "mother") > 0 Then
sh.Rows(i).Delete
End If
Next
End Sub
You can use this sh.Columns("A:C").Copy for copy more then one column Remember there are only 256 columns in Excel
Sub CopyColumn()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = Lastcol(DestSh)
sh.Columns("A:A").Copy DestSh.Columns(Last + 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyColumnValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = Lastcol(DestSh)
With sh.Columns("A:A")
DestSh.Columns(Last + 1).Resize(, _
.Columns.Count).Value = .Value
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
Set wsSheet = Nothing
On Error Resume Next
Set wsSheet = Sheets("TT")
On Error GoTo 0
If Not wsSheet Is Nothing Then
Sheets("TOC").Visible = True
Else
End If
从网上看到的， 转贴给有需要的人
偏方是：
新鮮荔枝的種子七粒、
打碎後用紗布包紮，再買一副豬腰，
切成薄片、切除白筋洗淨後，
與荔枝種子同時放在大碗公內，
加上第二次洗米水兩婉，
一起放在電鍋中蒸，大約蒸半小時，
然後一次把湯喝完，就能奏效。
http://www.mrexcel.com/forum/showthread.php?t=520537
Sub CopyMacro()
ActiveSheet.Range("a65536").End(xlUp).EntireRow.Copy
ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0).EntireRow.PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0).EntireRow.PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
End Sub
Sub addColumns()
Dim C As Long
Dim i As Long
C = ActiveSheet.UsedRange.Columns.Count
For i = C To 2 Step -1
Columns(i).Insert
Next
End Sub
Sub removeColumns()
Dim rng As Range
Dim C As Long
Dim i As Long
C = ActiveSheet.UsedRange.Columns.Count
For i = 1 To C
Set rng = ActiveSheet.Range(Cells(1, i), Cells(Rows.Count, i))
If Application.WorksheetFunction.CountA(rng) = 0 Then Columns(i).EntireColumn.Delete
Next i
End Sub
Sub HideMenuItems()
With Application.CommandBars("Row")
.Controls("Insert").Enabled = False
.Controls("Delete").Enabled = False
End With
With Application.CommandBars("Column")
.Controls("Insert").Enabled = False
.Controls("Delete").Enabled = False
End With
With CommandBars("Worksheet Menu Bar")
.Controls("Insert").Controls("Rows").Enabled = False
.Controls("Insert").Controls("Columns").Enabled = False
.Controls("Insert").Controls("Cells").Enabled = False
.Controls("Edit").Controls("Delete").Enabled = False
End With
End Sub
http://www.functionx.com/vbaexcel/Lesson15.htm
Dim r As Range
Set r = Rows(1).Find(What:="YourColumnName",LookIn:=xlValues,LookAt:=xlWhole)
'check if found:
If Not r Is Nothing Then
'found so insert:
r.EntireColumn.Insert 'inserts column to left, r.Offset(,1).EntireColumn.Insert to insert to right
Else
MsgBox "Column name not found!"
End If
Sub CreateTableOfContents()
' Copyright 2002 MrExcel.com
' Determine if there is already a Table of Contents
' Assume it is there, and if it is not, it will raise an error
' if the Err system variable is > 0, you know the sheet is not there
Dim WST As Worksheet
On Error Resume Next
Set WST = Worksheets("Table of Contents")
If Not Err = 0 Then
' The Table of contents doesn't exist. Add it
Set WST = Worksheets.Add(Before:=Worksheets(1))
WST.Name = "TOC"
End If
On Error GoTo 0
' Set up the table of contents page
WST.[A2] = "Table of Contents"
With WST.[A6]
.CurrentRegion.Clear
.Value = "Subject"
End With
WST.[B6] = "Page(s)"
WST.Range("A1:B1").ColumnWidth = Array(36, 12)
TOCRow = 7
PageCount = 0
' Do a print preview on all sheets so Excel calcs page breaks
' The user must manually close the PrintPreview window
Msg = "Excel needs to do a print preview to calculate the number of pages. "
Msg = Msg & "Please dismiss the print preview by clicking close."
MsgBox Msg
ActiveWindow.SelectedSheets.PrintPreview
' Loop through each sheet, collecting TOC information
' Loop through each sheet, collecting TOC information
For Each S In Worksheets
If S.Visible = -1 Then
S.Select
' Use any one of the following 3 lines
ThisName = ActiveSheet.Name
'ThisName = Range("A1").Value
'ThisName = ActiveSheet.PageSetup.LeftHeader
HPages = ActiveSheet.HPageBreaks.Count + 1
VPages = ActiveSheet.VPageBreaks.Count + 1
ThisPages = HPages * VPages
' Enter info about this sheet on TOC
Sheets("TOC").Select
Range("A" & TOCRow).Value = ThisName
Range("B" & TOCRow).NumberFormat = "@"
If ThisPages = 1 Then
Range("B" & TOCRow).Value = PageCount + 1 & " "
Else
Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages
End If
PageCount = PageCount + ThisPages
TOCRow = TOCRow + 1
End If
Next S
End Sub
Add-in to hide and show the worksheets in excel file. It helps alot when there's many worksheets in a single workbook
http://www.grbps.com/addhid.htm
description of add-in macro code
http://www.grbps.com/ExcelB.pdf
'Add a Sheet After Last Sheet in a Single Action [1]
Sub AddNewSheet()
Application.ScreenUpdating = False ' Prevents screen refreshing.
' This line adds a new worksheet to the workbook. Alternatively, use:
'
' DialogSheets.Add Adds a dialog sheet.
' Charts.Add Adds a chart sheet.
' Modules.Add Adds a Visual Basic module.
' Sheets.Add Type:=xlExcel4MacroSheet Adds an MS Excel 4.0 macro
' sheet.
Worksheets.Add
' This line makes the new sheet (which is also the active sheet) the
' last sheet in the workbook.
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
Application.ScreenUpdating = True ' Enables screen refreshing.
End Sub
Sub AddSheet() Application.EnableEvents = False ThisWorkbook.Sheets.Add Application.EnableEvents = True End Sub
http://dmcritchie.mvps.org/excel/buildtoc.htm
Edit Macro in Excel
How to use:
Copy above code.
In Excel press Alt + F11 to enter the VBE.
Press Ctrl + R to show the Project Explorer.
Right-click desired file on left.
Choose Insert -Module.
Paste code into the right pane.
Press Alt + Q to close the VBE.
Save workbook before any other changes.
Press Alt + F8, select 'CreateTOC', press Run.
Test the code:
From an existing workbook, save first.
Press Alt + F8.
Choose 'CreateTOC'.
Press 'Run'.
TOC sheet will be the left-most sheet added in your workbook.
一步一步走入沉默
Yi bu yi bu zou ru chen mo
我知道你带着伪装的笑容
Wo zhi dao ni dai zhe wei zhuang de xiao rong
选择继续不问是否
Xuan ze ji xu bu wen shi fou
如果你也听说
Ru guo ni ye ting shuo
帘幕落下不代表剧终
Lian mu luo xia bu dai biao ju zhong
说好为了梦想拼搏
Shuo hao wei le meng xiang pin bo
你却在我不经 意之下失踪
Ni que zai wo bu jing yi zhi xia shi zong
多希望你依然故我
Duo xi wang ni yi ran gu wo
不须牵挂什么
Bu xu qian gua shen me
努力实现每一个冲动
Nu li shi xian mei yi ge chong dong
*
爱情不是付出了许多
Ai qing bu shi fu chu le xu duo
就能得到相同的温柔
Jiu neng de dao xiang tong de wen rou
别把我当成朋友我要你懂
Bie ba wo dang cheng peng you wo yao ni dong
纠缠在这种关系之中
Jiu chan zai zhe zhong guan xi zhi zhong
**
爱情就像是一支独秀
Ai qing jiu xiang shi yi zhi du xiu
有时候没人在你左右
You shi hou mei ren zai ni zuo you
怎样都觉得不够找个借口
Zen yang dou jue de bu gou zhao ge jie kou
让你自由属于你的天空
Rang ni zi you shu yu ni de tian kong
把回忆留给昨天的你和我
Ba hui yi liu gei zuo tian de ni he wo
快乐变成泡沫
Kuai le bian cheng pao mo
伤心时最痛
Shang xin shi zui tong
