ASAP Utilities

  • Thread starter handung107
  • Ngày gửi
H

handung107

Cao cấp
28/8/04
576
15
0
VN
www.giaiphapexcel.com
Mình vừa Download file ASAP UTilities mà Làm Bạn với Máy Vi tính giới thiệu về hơn 300 tiện ích của Excel. Bạn nào cần thì mình gởi cho
 
Khóa học Quản trị dòng tiền
H

handung107

Cao cấp
28/8/04
576
15
0
VN
www.giaiphapexcel.com
levanduyet

levanduyet

Welcome
16/10/04
537
19
18
HCM
my.opera.com
Chao cac ban,
Cac ban co the dung phan mem AVPR de xem source code va hoc hoi (Thay doi password). Xin noi voi cac ban, chang qua day la phan mem mien phi nen...
Chi de hoc hoi thoi. Cac ban de y la khi cac ban bung ra vao mot thu muc thi cac ban se thay co nhieu file. Cac ban phai dung AVPR de mo het cac file moi duoc. Cac file nay chi duoc load khi chuong trinh su dung den no. That la tuyet. Nhung chang co thi gio ma xem dau.
Mot cong cu mien phi lam tang toc do cong viec cua ban len...bao nhieu thi tuy cac ban.
Chuc cac ban thanh cong.
levanduyet
 
levanduyet

levanduyet

Welcome
16/10/04
537
19
18
HCM
my.opera.com
Đánh giá phần I:
Thử tìm hiểu về phiên bản mới của ASAP Utilities Version 3.08, 15/10/2004.
Range::Find/ replace in all sheet
Nút Expand, khi lần đầu tiên form hiện ra thì nút này "hình như" không có tác dụng. Các bạn hãy đọc đọan mã dưới đây và tự phân tích xem sao:
Private Sub cmdExpand_Click()
Debug.Print Me.Top
Dim snFactor As Single
snFactor = 1.3325
Dim intDefFormHeight As Integer
Dim intDefListHeight As Integer
Dim intNewFormHeight As Integer
Dim intNewListHeight As Integer

intDefFormHeight = 297
intDefListHeight = 129
intNewFormHeight = 297 + (fnGetScreenWidth / snFactor / 5)
intNewListHeight = intNewFormHeight - 169
If Me.Height > intDefFormHeight Then
'??????????????????????????
Me.Height = intDefFormHeight
Me.lstFound.Height = intDefListHeight
cmdExpand.Caption = "Expand >>"
Else
Me.Height = intNewFormHeight
Me.lstFound.Height = intNewListHeight
cmdExpand.Caption = "<< Smaller"
End If
End Sub

Và sau đây là thủ tục tìm kiếm, cũng rất hay:
Sub sbFindReplace(strSearch As String, _
wsstart As Worksheet, _
strrngStartSearch As String, _
intLookIn As Integer, _
blnMatchCase, _
blnEntireCellsOnly, _
intSearchOrder As Integer)
If intLookIn = 0 Then
varLookIn = xlFormulas
Else
varLookIn = xlValues
End If
If blnEntireCellsOnly = True Then
varLookAt = xlWhole
Else
varLookAt = xlPart
End If
If intSearchOrder = 0 Then
varSearchOrder = xlByRows
Else
varSearchOrder = xlByColumns
End If
If strSearch = "" Then Exit Sub
i = 0
For Each ws In ActiveWorkbook.Worksheets
Set rng = ws.Cells.Find(What:=strSearch, _
After:=ws.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=varLookAt, _
SearchOrder:=varSearchOrder, _
SearchDirection:=xlNext, _
MatchCase:=blnMatchCase)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
If Not rng Is Nothing Then
lstFound.AddItem ws.Name
lstFound.Column(1, lstFound.ListCount - 1) = rng.Address
lstFound.Column(2, lstFound.ListCount - 1) = rng.Value
i = i + 1
End If
Set rng = ws.Cells.FindNext(rng)
Loop Until rng.Address = firstAddress
End If
Next ws
Me.lblItemsFound.Caption = i
End Sub
'''''''''''''''''''''
Sub sbFindReplace2()
Dim ws As Worksheet
Dim rng As Range
Dim strSearch As String
Dim ans As Variant
Dim firstAddress As String
strSearch = InputBox("Find what")
If strSearch = "" Then Exit Sub
For Each ws In ActiveWorkbook.Worksheets
Set rng = ws.Cells.Find(What:=strSearch, _
After:=ws.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
If Not rng Is Nothing Then
Application.GoTo rng, True
ans = MsgBox("Find Next?", _
vbYesNo + vbDefaultButton1)
If ans = vbNo Then Exit Sub
End If
Set rng = ws.Cells.FindNext(rng)
Loop Until rng.Address = firstAddress
End If
Next ws
End Sub
'''''''''''''''''''''''''''
Sub sbReplace(blnReplaceAll As Boolean)
If blnReplaceAll = False And lstFound.ListIndex = -1 Then
MsgBox "Select an entry to replace.", vbExclamation, AT
Me.lstFound.SetFocus
Exit Sub
End If
strSearch = Me.txtSearch.Text
strReplace = Me.txtReplace.Text
If Me.comLookIn.ListIndex = 0 Then
varLookIn = xlFormulas
Else
varLookIn = xlValues
End If
If Me.chkEntireCellsOnly = True Then
varLookAt = xlWhole
Else
varLookAt = xlPart
End If
If Me.comSearch.ListIndex = 0 Then
varSearchOrder = xlByRows
Else
varSearchOrder = xlByColumns
End If
Application.ScreenUpdating = False
If blnReplaceAll = False Then
Sheets(lstFound.List(lstFound.ListIndex, 0)).Select
Range(lstFound.List(lstFound.ListIndex, 1)).Select
ActiveCell.Replace strSearch, strReplace, varLookAt,varSearchOrder,
Me.chkMatchCase
lstFound.Column(3, lstFound.ListIndex) = "-> " & ActiveCell.Value
If lstFound.ListIndex < lstFound.ListCount - 1 Then lstFound.ListIndex = lstFound.ListIndex + 1
Else
For i = 0 To Me.lblItemsFound.Caption - 1
Sheets(lstFound.List(i, 0)).Select
Range(lstFound.List(i, 1)).Select
ActiveCell.Replace strSearch, strReplace, varLookAt, _
varSearchOrder,Me.chkMatchCase
lstFound.Column(3, i) = "-> " & ActiveCell.Value
Next i
End If
' Nham tang toc do chuong trinh
Application.ScreenUpdating = True
End Sub
Number:: Number to words
Có thể nói đây là hàm chuyển số thành chữ. Hàm chuyển số thành chữ ở các thứ tiếng: Anh, Đức, Hà Lan.
Sau đây là module modSpellNumberFuntions của tác giả:
Option Explicit
Sub Test()
ActiveCell.Offset(1, 1).Value = fnSpellNumbersEN(ActiveCell.Value, False, "euro", "euros", "comma", "cent", "cents")
ActiveCell.Offset(2, 1).Value = fnSpellNumbersEN(ActiveCell.Value, False, "euro", "euros", "point", "cent", "cents")
ActiveCell.Offset(8, 1).Value = fnSpellNumbersDE(ActiveCell.Value, True, "DM", "DM", "komma", "pfennig", "pfennige")
ActiveCell.Offset(9, 1).Value = fnSpellNumbersDE(ActiveCell.Value, True, "euro", "euros", "komma", "cent", "cents")
ActiveCell.Offset(10, 1).Value = fnSpellNumbersDE(ActiveCell.Value, False, "euro", "euros", "komma", "cent", "cents")
ActiveCell.Offset(11, 1).Value = fnSpellNumbersDE(ActiveCell.Value, False, "euro", "euros", "point", "cent", "cents")
ActiveCell.Offset(18, 1).Value = fnSpellNumbersNL(ActiveCell.Value, True, "DM", "DM", "komma", "pfennig", "pfennige")
ActiveCell.Offset(19, 1).Value = fnSpellNumbersNL(ActiveCell.Value, True, "euro", "euros", "komma", "cent", "cents")
ActiveCell.Offset(20, 1).Value = fnSpellNumbersNL(ActiveCell.Value, False, "euro", "euros", "komma", "cent", "cents")
ActiveCell.Offset(21, 1).Value = fnSpellNumbersNL(ActiveCell.Value, False, "euro", "euro", "komma", "cent", "cent")
End Sub
Function fnSpellNumbersEN( _
ByVal MyNumber, _
blnCurrency As Boolean, _
Optional strSingular As String, _
Optional strPlural As String, _
Optional strComma As String, _
Optional strCentSingular As String, _
Optional strCentPlural As String _
)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
Cents = fnGetTensEN(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = fnGetHundredsEN(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
If blnCurrency Then Dollars = "No " & strPlural
Case "One"
If blnCurrency Then
Dollars = "One " & strPlural
Else
Dollars = "One"
End If
Case Else
If blnCurrency Then
Dollars = Dollars & " " & strPlural
Else
Dollars = Dollars
End If
End Select
Select Case Cents
Case ""
If blnCurrency Then Cents = " and No " & strCentPlural
Case "One"
If blnCurrency Then
Cents = " and One " & strCentSingular
Else
Cents = " " & strComma & " zero One"
End If
Case Else
If blnCurrency Then
Cents = " and " & Cents & " " & strCentPlural
Else
If fnSmallerAsTenEN(Cents) Then
Cents = " " & strComma & " zero " & Cents
Else
Cents = " " & strComma & " " & Cents
End If
End If
End Select
fnSpellNumbersEN = Dollars & Cents
End Function
Function fnGetHundredsEN(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
If Mid(MyNumber, 1, 1) <> "0" Then
Result = fnGetDigitEN(Mid(MyNumber, 1, 1)) & " Hundred "
End If
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & fnGetTensEN(Mid(MyNumber, 2))
Else
Result = Result & fnGetDigitEN(Mid(MyNumber, 3))
End If
fnGetHundredsEN = Result
End Function
Function fnGetTensEN(TensText)
Dim Result As String
Result = ""
If Val(Left(TensText, 1)) = 1 Then
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & fnGetDigitEN _
(Right(TensText, 1))
End If
fnGetTensEN = Result
End Function
Function fnGetDigitEN(Digit)
Select Case Val(Digit)
Case 1: fnGetDigitEN = "One"
Case 2: fnGetDigitEN = "Two"
Case 3: fnGetDigitEN = "Three"
Case 4: fnGetDigitEN = "Four"
Case 5: fnGetDigitEN = "Five"
Case 6: fnGetDigitEN = "Six"
Case 7: fnGetDigitEN = "Seven"
Case 8: fnGetDigitEN = "Eight"
Case 9: fnGetDigitEN = "Nine"
Case Else: fnGetDigitEN = ""
End Select
End Function
 
levanduyet

levanduyet

Welcome
16/10/04
537
19
18
HCM
my.opera.com
Đánh giá phần II:Private Function fnSmallerAsTenEN(strGetal) As Boolean
Select Case strGetal
Case "One": fnSmallerAsTenEN = True
Case "Two": fnSmallerAsTenEN = True
Case "Three": fnSmallerAsTenEN = True
Case "Four": fnSmallerAsTenEN = True
Case "Five": fnSmallerAsTenEN = True
Case "Six": fnSmallerAsTenEN = True
Case "Seven": fnSmallerAsTenEN = True
Case "Eight": fnSmallerAsTenEN = True
Case "Nine": fnSmallerAsTenEN = True
Case Else: fnSmallerAsTenEN = False
End Select
End Function
Function fnSpellNumbersDE( _
ByVal MyNumber, _
blnCurrency As Boolean, _
Optional strSingular As String, _
Optional strPlural As String, _
Optional strComma As String, _
Optional strCentSingular As String, _
Optional strCentPlural As String _
)
Dim Temp
Dim DM, Pfennige
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = "tausend"
Place(3) = "millionen"
Place(4) = "milliarden"
Place(5) = "billiarden"
MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Pfennige = fnConvertTensDE(Temp)
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = fnConvertHundredsDE(Right(MyNumber, 3))
If Temp <> "" Then DM = Temp & Place(Count) & DM
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case DM
Case ""
If blnCurrency = True Then
DM = "keine " & strSingular
Else
DM = ""
End If
Case "Eins"
If blnCurrency = True Then
DM = "eine " & strSingular
Else
DM = "eins"
End If
Case Else
If blnCurrency = True Then
DM = DM & " " & strPlural
End If
End Select
Select Case Pfennige
Case ""
If blnCurrency = True Then
Pfennige = " und keine " & strCentPlural
End If
Case "Ein"
If blnCurrency = True Then
Pfennige = " und ein " & strCentSingular
Else
Pfennige = " " & strComma & " nul eins"
End If
Case Else
If blnCurrency = True Then
Pfennige = " und " & Pfennige & " " & strCentPlural
Else
If fnSmallerAsTenDE(Pfennige) Then
Pfennige = " " & strComma & " nul " & Pfennige
Else
Pfennige = " " & strComma & " " & Pfennige
End If
End If
End Select
fnSpellNumbersDE = DM & Pfennige
End Function
Private Function fnConvertHundredsDE(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
If Left(MyNumber, 1) <> "0" Then
Result = fnConvertDigitDE(Left(MyNumber, 1)) & "hundert"
End If
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & fnConvertTensDE(Mid(MyNumber, 2))
Else
Result = Result & fnConvertDigitDE(Mid(MyNumber, 3))
End If
fnConvertHundredsDE = Trim(Result)
End Function
Private Function fnConvertTensDE(ByVal MyTens)
Dim Result As String
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "zehn"
Case 11: Result = "elf"
Case 12: Result = "zwölf"
Case 13: Result = "dreizehn"
Case 14: Result = "vierzehn"
Case 15: Result = "fünfzehn"
Case 16: Result = "sechzehn"
Case 17: Result = "siebzehn"
Case 18: Result = "achtzehn"
Case 19: Result = "neunzehn"
Case Else
End Select
Else
Select Case Val(Left(MyTens, 1))
Case 2: Result = "zwanzig "
Case 3: Result = "dreißig "
Case 4: Result = "vierzig "
Case 5: Result = "fünfzig "
Case 6: Result = "sechzig "
Case 7: Result = "siebzig "
Case 8: Result = "achtzig "
Case 9: Result = "neunzig "
Case Else
End Select
End If
If Val(Left(MyTens, 1)) = 0 And Val(Right(MyTens, 1)) <> 0 Then Result = Result & fnConvertDigitDE(Right(MyTens, 1))
If Val(Left(MyTens, 1)) <> 0 And Val(Right(MyTens, 1)) <> 0 And MyTens > 19 Then Result = fnConvertDigitDE(Right(MyTens, 1)) & "und" & Result
fnConvertTensDE = Result
End Function
Private Function fnConvertDigitDE(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: fnConvertDigitDE = "ein"
Case 2: fnConvertDigitDE = "zwei"
Case 3: fnConvertDigitDE = "drei"
Case 4: fnConvertDigitDE = "vier"
Case 5: fnConvertDigitDE = "fünf"
Case 6: fnConvertDigitDE = "sechs"
Case 7: fnConvertDigitDE = "sieben"
Case 8: fnConvertDigitDE = "acht"
Case 9: fnConvertDigitDE = "neun"
Case Else: fnConvertDigitDE = ""
End Select
End Function
Private Function fnSmallerAsTenDE(strGetal) As Boolean
Select Case strGetal
Case "ein": fnSmallerAsTenDE = True
Case "zwei": fnSmallerAsTenDE = True
Case "drei": fnSmallerAsTenDE = True
Case "vier": fnSmallerAsTenDE = True
Case "fünf": fnSmallerAsTenDE = True
Case "sechs": fnSmallerAsTenDE = True
Case "sieben": fnSmallerAsTenDE = True
Case "acht": fnSmallerAsTenDE = True
Case "neun": fnSmallerAsTenDE = True
Case Else: fnSmallerAsTenDE = False
End Select
End Function
Function fnSpellNumbersNL( _
ByVal MyNumber, _
blnCurrency As Boolean, _
Optional strSingular As String, _
Optional strPlural As String, _
Optional strComma As String, _
Optional strCentSingular As String, _
Optional strCentPlural As String _
)
Dim Temp
Dim DM, Pfennige
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = "duizend"
Place(3) = "miljoen"
Place(4) = "miljard"
Place(5) = "biljard"
MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Pfennige = fnConvertTensNL(Temp)
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = fnConvertHundredsNL(Right(MyNumber, 3))
If Temp <> "" Then DM = Temp & Place(Count) & DM
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case DM
Case ""
If blnCurrency = True Then
DM = "geen " & strSingular
Else
DM = ""
End If
Case "Eins"
If blnCurrency = True Then
DM = "één " & strSingular
Else
DM = "één"
End If
Case Else
If blnCurrency = True Then
DM = DM & " " & strPlural
End If
End Select
Select Case Pfennige
Case ""
If blnCurrency = True Then
Pfennige = " en nul " & strCentPlural
Else
Pfennige = " " & strComma & " nul "
End If
Case "Ein"
If blnCurrency = True Then
Pfennige = " en een " & strCentSingular
Else
Pfennige = " " & strComma & " nul één"
End If
Case Else
If blnCurrency = True Then
Pfennige = " en " & Pfennige & " " & strCentPlural
Else
If fnSmallerAsTenNL(Pfennige) Then
Pfennige = " " & strComma & " nul " & Pfennige
Else
Pfennige = " " & strComma & " " & Pfennige
End If
End If
End Select
fnSpellNumbersNL = DM & Pfennige
End Function
Private Function fnConvertHundredsNL(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
If Left(MyNumber, 1) <> "0" Then
Result = fnConvertDigitNL(Left(MyNumber, 1)) & "honderd"
End If
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & fnConvertTensNL(Mid(MyNumber, 2))
Else
Result = Result & fnConvertDigitNL(Mid(MyNumber, 3))
End If
fnConvertHundredsNL = Trim(Result)
End Function
Private Function fnConvertTensNL(ByVal MyTens)
Dim Result As String
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "tien"
Case 11: Result = "elf"
Case 12: Result = "twaalf"
Case 13: Result = "dertien"
Case 14: Result = "veertien"
Case 15: Result = "vijftien"
Case 16: Result = "zestien"
Case 17: Result = "zeventien"
Case 18: Result = "achttien"
Case 19: Result = "negentien"
Case Else
End Select
Else
Select Case Val(Left(MyTens, 1))
Case 2: Result = "twintig "
Case 3: Result = "dertig "
Case 4: Result = "veertig "
Case 5: Result = "vijftig "
Case 6: Result = "zestig "
Case 7: Result = "zeventig "
Case 8: Result = "tachtig "
Case 9: Result = "negentig "
Case Else
End Select
End If
If Val(Left(MyTens, 1)) = 0 And Val(Right(MyTens, 1)) <> 0 Then Result = Result & fnConvertDigitNL(Right(MyTens, 1))
If Val(Left(MyTens, 1)) <> 0 And Val(Right(MyTens, 1)) <> 0 And MyTens > 19 Then Result = fnConvertDigitNL(Right(MyTens, 1)) & "en" & Result
fnConvertTensNL = Result
End Function
Private Function fnConvertDigitNL(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: fnConvertDigitNL = "één"
Case 2: fnConvertDigitNL = "twee"
Case 3: fnConvertDigitNL = "drie"
Case 4: fnConvertDigitNL = "vier"
Case 5: fnConvertDigitNL = "vijf"
Case 6: fnConvertDigitNL = "zes"
Case 7: fnConvertDigitNL = "zeven"
Case 8: fnConvertDigitNL = "acht"
Case 9: fnConvertDigitNL = "negen"
Case Else: fnConvertDigitNL = ""
End Select
End Function
Private Function fnSmallerAsTenNL(strGetal) As Boolean
Select Case strGetal
Case "één": fnSmallerAsTenNL = True
Case "twee": fnSmallerAsTenNL = True
Case "drie": fnSmallerAsTenNL = True
Case "vier": fnSmallerAsTenNL = True
Case "vijf": fnSmallerAsTenNL = True
Case "zes": fnSmallerAsTenNL = True
Case "zeven": fnSmallerAsTenNL = True
Case "acht": fnSmallerAsTenNL = True
Case "negen": fnSmallerAsTenNL = True
Case Else: fnSmallerAsTenNL = False
End Select
End Function
Các bạn hãy tự nghiên cứu nha!
Objects :: new name : Objects/Comments
Theo tôi công cụ này cũng hay nhưng chắc có lẻ ích sử dụng.
Custom functions
Đưa thêm một hàm cho phép bạn đọc một comment của một ô. Ví dụ:
=ASAPGetComment(reference), tức là =ASAPGetComment(B1)

Custom functions
Đưa thêm một hàm cho phép bạn lấy colornumber của một ô. Điều này sẽ giúp cho bạn khi bạn muốn sắp xếp ô theo màu.
=ASAPCellColorIndex(reference), tức là =ASAPCellColorIndex(B12)
System :: Find and remove external links
Tìm và xóa các links với nguồn ở ngòai.
Đôi khi các bạn mở một workbook cứ có thông báo update links thật là chán phải không?
Các bạn hãy dùng công cụ này để tìm kiếm và xóa các links.

Lê Văn Duyệt
 
B

Bình_OverAC

Over Abnormal / Crazy
14/5/04
846
10
18
42
Nha Trang
Chào chị handung107,
em vừa mới download xong cái ASAP nhưng không biết công dụng chính của nó là gì? Chị có thể cho em biết được không?
Và những điều đặc biệt của nó nữa

Ai chưa có cái này có thế down load ở đây www.asap-utilities.com
 
levanduyet

levanduyet

Welcome
16/10/04
537
19
18
HCM
my.opera.com
Chao cac ban,
Cac ban doc bai phan tich cua minh ve ASAP.
Day la cong cu hay tuyet.
Le Van Duyet
 
levanduyet

levanduyet

Welcome
16/10/04
537
19
18
HCM
my.opera.com
Chao,
Sao cac ban khong vao link chinh thuc de download boi vi file cung lon.
Con ve cach su dung thi...Khi cac ban tu tim hieu...cac ban se kham pha mot the gioi Excel...that la tuyet.
Cac ban phai "dau tu" thoi. Chi co phuong cach nay cac ban moi...kham pha duoc.
Chuc cac ban kham pha...nhieu nhieu...
Le Van Duyet
 
H

handung107

Cao cấp
28/8/04
576
15
0
VN
www.giaiphapexcel.com
Các bạn à, địa chỉ link tôi đã chép để các bạn down thẳng từ lâu, nên tôi không gởi riêng cho bạn nào nữa cả, bây giờ bạn levanduyet cũng ghi lại, các bạn cứ theo đó mà tải về. Khi tải về máy của các bạn, các bạn giải nén vào thư mục Add-in của Microsoft Office xong, các bạn sẽ thấy trên thanh công cụ của Excel có Asap Utilities. Qua đó, bạn cứ thử tìm tòi và khám phá. Bạn chỉ cần biết chừng vài chức năng nhỏ như :
- Bỏ chọn một vài Cell trong một vùng đã chọn : Td bạn chọn vùng A1:C50, nhưng lại muốn bỏ vùng B3:C5, A7:B10..., bảo đảm Asap Utilities sẽ đem lại cho bạn một cách dễ dàng bằng chức năng Select/Deselect Cell.
-Nếu bạn muốn đánh dấu các hàng hay cột bằng cách tô màu các hàng , cột thứ n thì chức năng Columns, Rows/Color each n'th row or column sẽ giúp bạn
-Nếu bạn muốn tạo cho workbook của bạn một trang Index với các link cho các sheet trong workbook, chức năng Sheets/Create an Index page with all sheet (clickable) sẽ dành cho việc này
-Nếu bạn muốn sắp xếp các sheet theo thứ tự ABC đã có Sheets/Sort all sheets in alphabetic order
Thật ra, ngoài Asap Utilities còn rất nhiều cái khác như Excel Utilities tải ở www.appspro.com cũng có những chức năng tương tự. Về Asap Utilities còn nhiều cái hay lắm, mời bạn khám phá từ từ.
Trước đây, khi tôi giới thiệu về Asap utilities, có bạn đã chê cái bản download này là dở vì chỉ là bản Demo nên chức năng bị hạn chế và đề nghị cung cấp Key để xài bản chính thức, vì thế tôi chờ bạn ấy đưa cho các bạn cái tốt hơn, bản thân tôi cũng muốn có cái "xịn" đó, không hiểu sao bạn Nipvn chỉ nói thế thôi, chứ không thấy gì cả
To levanduyet : Bạn quả là một chuyên gia về VBA, nhưng đa số WKT là dân không chuyên về lập trình nên mấy cái source code VBA khó hiểu quá, bạn hướng dẫn kỹ hơn và ít ít một, bản thân tôi cũng biết sơ sơ về Visual Basic, mà đọc còn thấy khổ, dù sao cũng rất cám ơn bạn đã giúp tôi hiểu thêm một ít kiến thức về VBA
 
H

handung107

Cao cấp
28/8/04
576
15
0
VN
www.giaiphapexcel.com
Có lẽ các bạn cũng đã tìm thấy và đồng ý cùng tôi chức năng bỏ chọn nhiều vùng khác nhau trong một vùng chọn trước của Asap thật là tuyệt, nó giảm công sức cho chúng ta khá nhiều. Hôm nay chúng ta sẽ tìm thêm vài chức năng hữu ích khác.
- Trong menu Favorite/Expand selection to last row, column hay Select/Expand selection to last row, column cho phép bạn đặt con trỏ ở Cell đầu tiên mà vẫn chọn được một vùng đến hàng hay cột cuối cùng có chứa dữ liệu.
- Favorites/Move or resize selection cho phép bạn di chuyển vùng chọn lựa qua trái, phải, trên, dưới bằng nút lớn, trong khi với hàng nút nhỏ, bạn có thể chọn thêm từng hàng, cột qua trái, phải, trên, dưới cho vùng chọn của mình
- Trong vùng chọn bạn cũng có thể lọc ra những Cell chứa những giá trị giống nhau hay khác nhau bằng Select/Select cells in column with same value (below and above active cell) và Select/Select cells in selection where value changes. Và những Cell chứa giá trị Max trong vùng chọn với Select/Select Cell with maximum value
- Trong Favorites hay Formula/Apply formula to select Cell cho phép bạn áp dụng cùng một công thức cho vùng chọn của mình, còn Favorites hay Formula/Convert formula to their value đúng như cái tên của nó là các cell chọn có công thức sẽ chỉ còn giá trị số học sau khi công thức tính toán đã được thực hiện
- Với Sheets/Print multiple sheets là thú vị nhất nó cho phép bạn chọn in cùng lúc nhiều Sheets trong workbook, các chức năng khác như Sheets/Add sheet(input box will appear for the name) giúp bạn vừa Insert worksheet vừa đặt tên cho nó (tên được nhập thẳng vào Input box), trong khi Sheets/Add sheets (with the names defined in selected cells) giúp bạn Insert và đặt tên cùng lúc rất nhiều Sheets ( td bạn sẽ đặt tên cho 17 Sheets bằng cách nhập các tên này vào B1:B17, rồi chọn vùng này và gọi chức năng trên, ngay lập tức 17 Sheets sẽ xuất hiện cùng những cái tên có sẵn trong các Cell của vùng B1:B17)
Đến đây bạn hẳn đã thấy Asap Utilities có nhiều công dụng hay lắm chứ. Hẹn các bạn dịp khác nhé
 
H

handung107

Cao cấp
28/8/04
576
15
0
VN
www.giaiphapexcel.com
Mấy ngày nay trên diễn đàn có những bài viết về "Tên và nhãn", về in các trang, về tách gộp các File..., vì vậy, tôi xin giới thiệu với các bạn thêm vài chức năng sẵn có của Asap-Utilities, mà càng khám phá, tôi càng cảm thấy Add-in này hay vô cùng.
1/ Về In : các bạn có thể sử dụng các menu sau :
- Format / Copy a Sheet's page and print setting , với chức năng này, bạn có thể vừa chỉ định các kiểu Copy, định dạng, Title, Header and Footer, canh lề trái, phải, giữa...vừa Set up trang in
- Sheets / Print multiple sheets : Các bạn có thể chọn những Sheet nào muốn in, chọn File muốn in, chọn máy in (trường hợp máy bạn kết nối với nhiều máy in), bạn cũng có thể biết Sheet của bạn chứa bao nhiêu trang nữa.
-Select / Set Current Selection default to all Sheet : Bạn có thể chọn một vùng in nào đó và áp dụng vùng chọn này cho tất cả các Sheet trong Workbook
- Về in còn có các chức năng sau : Print preview Selection, Print Selection và Sheets / Delete Print area on Selected Sheets (Xoá vùng in trên những Sheet được chọn)
2/ Tách gộp các File : Có các Menu sau :
- Import / Insert Excel Files : Chức năng này giúp bạn Insert tất cả các Sheet có trên một File Excel nào d0ó vào trong Workbook đang làm việc của bạn, (nghĩa là bạn vừa có thể Copy vừa Insert tất cả các Sheet từ một File khác dễ dàng và nhanh chóng)
- Import / Insert dBase File : Giống như trên, nhưng là một File CSDL
- Merge Files together in a new File : chức năng này kết hợp dữ liệu của tất cả các Sheet hiện có vào một Sheet duy nhất trong một Workbook mới
3/ Chức năng Export / Export selection or active Sheet as New File sẽ giúp bạn xuất phần chọn hoặc Sheet chọn thành một File mới
- Export / Save Selected range A Bitmap Image , và Export selected chart or range as image (file) giúp bạn lưu vùng chọn dưới dạng hình ảnh với các đuôi jpg, gif, png..., và bạn có thể chèn hình ảnh này vào bất cứ File nào khác
4/ Menu Information / List all range name (liệt kê tên trong Workbook), List all sheet Names (Liệt kê tên các Sheet)
- Information / Count Duplicates in Selection giúp bạn nhận biết có bao nhiêu giá trị trùng nhau trong vùng chọn, và nếu bạn cần, nó sẽ tô màu những giá trị này. Ngược lại, Count Unique Values in selection sẽ cho bạn biết những giá trị duy nhất có trong vùng chọn
- Information / Fast and Calculation sẽ giúp bạn có ngay những giá trị Max, Min, Giá trị TB, tổng của vùng chọn, sẽ cho bạn biết có bao nhiêu Cell trống, bao nhiêu Cell có giá trị số, giá trị Text, và nếu bạn muốn, nó sẽ chép vùng bạn chọn qua một Sheet mới
Trên đây là một số chức năng của Asap-Utilities, hy vọng công cụ này sẽ trở thành người bạn tốt nhất cho tất cả các bạn thường sử dụng Excel để tính toán
 
A

Anhchuot

Lên thớt...
23/7/03
362
6
18
Hanoi
www.
Đến giờ AC mới có được add in này, tiếc vì cập nhật muộn quá, mấy bài cơ bản chị handung107 hướng dẫn rất có ích. Cám ơn chị nhiều.
 
D

datartex

Sơ cấp
12/8/05
20
0
1
51
Hanoi
Kính gửi chị HanhDung.

Tôi đã download bản ASAP 3.10 và cài đặt vào máy tuy nhiên toàn bị báo lỗi không biết tại sao. Tôi đang dùng WIN98 OFFICE 2000. Mong chị chỉ dẫn giúp
 

Xem nhiều

Webketoan Zalo OA