Mind Hacking

Sub DeleteEmptyRows()

Dim LastRow As Long

Dim r As Long

Dim Counter As Long

Application.ScreenUpdating = False

LastRow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row – 1

For r = LastRow To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then

Rows(r).Delete

Counter = Counter + 1

End If

Next r

Application.ScreenUpdating = False

MsgBox Counter & “empty rows were deleted”

End Sub

Sub GetUserRange2()

Dim UserRange As Range

Application.ScreenUpdating = False

Set UserRange = Application.InputBox(Prompt:=”For test”, Title:=”Test”, _

Default:=ActiveCell.Address, Type:=8) ‘Range selection

Application.ScreenUpdating = True

End Sub

CL-USER 4 : 1 >(eq ‘() nil)

T

CL-USER 5 : 1 > (eq ‘() ())

T

CL-USER 6 : 1 > (eq ‘() ‘nil)

T

CL-USER 7 : 1 > (if (= (+ 1 2) 3) ‘yup ‘nope)

YUP

CL-USER 8 : 1 > (if (= (+ 1 2) 4) ‘yup ‘nope)

NOPE

CL-USER 9 : 1 > (if ‘(1) ‘the-list-has-stuff-in-it ‘the-list-is-empty)

THE-LIST-HAS-STUFF-IN-IT

CL-USER 10 : 1 > (if ‘() ‘the-list-has-stuff-in-it ‘this-list-is-empty)

THIS-LIST-IS-EMPTY

CL-USER 11 : 1 > (if (oddp 5) ‘odd-number ‘even-number)

ODD-NUMBER

CL-USER 12 : 1 > (if (oddp 5) ‘odd-number (/ 1 0))

ODD-NUMBER

CL-USER 2 : 1 > (defvar *number-is-odd* nil)

*NUMBER-IS-ODD*

CL-USER 3 : 1 > (when (oddp 5) (setf *number-is-odd* t) ‘odd-number)

ODD-NUMBER

CL-USER 4 : 1 > *number-is-odd*

T

CL-USER 5 : 1 > (unless (oddp 4) (setf *number-is-odd* nil) ‘even-number)

EVEN-NUMBER

CL-USER 6 : 1 > *number-is-odd*

NIL

CL-USER 1 > (if ‘() ‘I-am-true ‘I-am-false)

I-AM-FALSE

哈哈 ‘() 代表False，也就是”This example shows that when we pass the empty list () into an if form, it evaluates as a false value, whereas a list that contains an item evaluates as true.”

CL-USER 2 > (if ‘(1) ‘This-is-True ‘This-is-false)

THIS-IS-TRUE

‘(1) 当然代表真

CL-USER 3 > (if ‘(haha) ‘This-is-True ‘This-is-false)

THIS-IS-TRUE

CL-USER 4 > (defun my-length (list) (if list (1+ (my-length (cdr list))) 0))

MY-LENGTH

CL-USER 5 > (my-length ‘(list with four symbols))

4

(defun my-length (list)

(if list

(1+ (my-length (cdr list)))

0))

(my-length ‘(list with four symbols))

Function XDATE(y, m, d, Optional fmt As String) As String

If IsMissing(fmt) Then fmt = “Short Date”

XDATE = Format(DateSerial(y, m, d), fmt)

End Function

Function XDATEADD(xdate1, days, Optional fmt As String) As String

Dim TempDate As Date

If IsMissing(fmt) Then fmt = “Short Date”

xdate1 = RemoveDay(xdate1)

TempDate = DateValue(xdate1)

XDATEADD = Format(TempDate + days, fmt)

End Function

Function XDATEDIF(xdate1, xdate2) As Long

xdate1 = RemoveDay(xdate1)

xdate2 = RemoveDay(xdate2)

XDATEDIF = DateSerial(Year(xdate1), Month(xdate1), Day(xdate1)) – DateSerial(Year(xdate2), Month(xdate2), Day(xdate2))

End Function

Function XDATEYEARDIF(xdate1, xdate2) As Long

Dim YearDiff As Long

xdate1 = RemoveDay(xdate1)

xdate2 = RemoveDay(xdate2)

YearDiff = Year(xdate2) – Year(xdate1)

If DateSerial(Year(xdate1), Month(xdate2), Day(xdate2)) < CDate(xdate1) Then YearDiff = YearDiff – 1

XDATEYEARDIF = YearDiff

End Function

Function XDATEYEAR(xdate1)

xdate1 = RemoveDay(xdate1)

XDATEYEAR = Year(DateValue(xdate1))

End Function

Function XDATEMONTH(xdate1)

xdate1 = RemoveDay(xdate1)

XDATEMONTH = Month(DateValue(xdate1))

End Function

Function XDATEDAY(xdate1)

xdate1 = RemoveDay(xdate1)

XDATEDAY = Day(DateValue(xdate1))

End Function

Function XDATEDOW(xdate1)

xdate1 = RemoveDay(xdate1)

XDATEDOW = Weekday(xdate1)

End Function

Private Function RemoveDay(xdate1)

‘ Remove day of week from string

Dim i As Integer

Dim Temp As String

Temp = xdate1

For i = 0 To 6 ‘Unabbreviated day names

Temp = Application.Substitute(Temp, Format(DateSerial(1900, 1, 0), “dddd”), “”)

Next i

For i = 0 To 6 ‘Abbreviated day names

Temp = Application.Substitute(Temp, Format(DateSerial(1900, 1, 0), “ddd”), “”)

Next i

RemoveDay = Temp

End Function

Sub SetMacroOptions()

‘ Add descriptions, and put in the Date & Time function category

On Error Resume Next

With Application

.MacroOptions macro:=”XDATE”, Description:=”Returns a date for any year between 0100 and 9999. fmt is an optional date formatting string.”, Category:=2

.MacroOptions macro:=”XDATEADD”, Description:=”Returns a date, incremented by a specified number of days. fmt is an optional date formatting string.”, Category:=2

.MacroOptions macro:=”XDATEDIF”, Description:=”Returns the number of days between date1 and date2 (date1-date2).”, Category:=2

.MacroOptions macro:=”XDATEYEARDIF”, Description:=”Returns the number of full years between date1 and date2 (date1-date2). Useful for calculating ages.”

.MacroOptions macro:=”XDATEYEAR”, Description:=”Returns the year for a date.”

.MacroOptions macro:=”XDATEMONTH”, Description:=”Returns the month for a date.”

.MacroOptions macro:=”XDATEDAY”, Description:=”Returns the day for a date.”

.MacroOptions macro:=”XDATEDOW”, Description:=”Returns an integer corresponding to the weekday for a date (1=Sunday).”

End With

End Sub

Sub DescribeFunction()

Dim FunctionName As String

Dim FunctionDescription As String

Dim FunctionCategory As Long

‘Dim Arg1Desc As String, Arg2Desc As String

FunctionName = “ROWN”

FunctionDescription = “模拟Row函数返回行数”

FunctionCategory = 5

Application.MacroOptions Macro:=FunctionName, Description:=FunctionDescription, Category:=FunctionCategory

End Sub

Declare PtrSafe Function GetWindowsDirectoryA Lib “kernel32″ (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Sub ShowWindowsDir()

Dim WinPath As String * 255

Dim WinDir As String

WinPath = Space(255)

WinDir = Left(WinPath, GetWindowsDirectoryA(WinPath, Len(WinPath)))

MsgBox WinDir, vbInformation, “Windows Directory”

End Sub

Function WindowsDir()

‘Return the Windows directory

Dim WinPath As String * 255

WinPath = Space(255)

WindowsDir = Left(WinPath, GetWindowsDirectoryA(WinPath, Len(WinPath)))

End Function

#If VBA7 And Win64 Then

Declare PtrSafe Function GetKeyState Lib “user32″ (ByVal nVirtKey As Long) As Integer

#Else

Declare Function GetKeyState Lib “user32″ (ByVal nVirtKey As Long) As Integer

#End If

‘ Constants for the keys of interest

Const VK_SHIFT As Integer = &H10

Const VK_CONTROL As Integer = &H11

Const VK_MENU As Integer = &H12 ‘Alt key

Sub DisplayKeyStatus()

Dim TabChar As String * 1

Dim CRChar As String * 1

Dim Shift As Boolean, Control As Boolean, Alt As Boolean

Dim Msg As String

TabChar = Chr(9)

CRChar = Chr(13)

‘ Use API calls to determine which keys are pressed

If GetKeyState(VK_SHIFT) < 0 Then Shift = True Else Shift = False

If GetKeyState(VK_CONTROL) < 0 Then Control = True Else Control = False

If GetKeyState(VK_MENU) < 0 Then Alt = True Else Alt = False

‘ Build the message

Msg = “Shift:” & TabChar & Shift & CRChar

Msg = Msg & “Control:” & TabChar & Control & CRChar

Msg = Msg & “Alt:” & TabChar & Alt & CRChar

‘ Display message box

MsgBox Msg, vbInformation, “Key Status”

End Sub