Mỗi tuần một hàm VBA

KDK · 9/6/06

Tôi mạn phép lấy tên chủ đề này như thế, vì tôi chẳng biết gì nhiều về VBA mà lại lập ra Topic này. Nhưng khi vào diễn đàn trang www.ketcau.com, tôi thấy có Topic này hay quá, chỉ có điều là những hàm VBA ở trang này chỉ chuyên tính kết cấu xây dựng, dầm, pha, cốt thép..., do đó, tôi mong muốn chủ đề này sẽ được các anh chị quan tâm và từ đây, chúng ta sẽ có thêm rất nhiều các hàm VBA tự tạo đầy tính thiết thực phục vụ cho công việc của mỗi chúng ta

KDK · 9/6/06

Hàm chuyển góc ở dạng số thập phân ra góc ở dạng độ

Hàm chuyển góc ở dạng số thập phân ra góc ở dạng độ (vd:12°15'):

PhanTuHuong (www.ketcau.com)

Function Chuyengoc(Gocthapphan As Double) 'Đổi thành góc độ
Dim Goc, Goctrai, Gocphai
Goc = Round(Gocthapphan, 2)
Goctrai = Int(Goc)
Gocphai = Round(Goctrai * 0.6, 0)
If Gocphai >= 10 Then
Chuyengoc = Goctrai & "°" & Gocphai & "'"
ElseIf Gocphai < 10 Then
Chuyengoc = Goctrai & "°" & "0" & Gocphai & "'"
Else
Chuyengoc = "Sai dau vao roi !!!!!!!!"
End If
End Function

handung107 · 10/6/06

Hàm cho ra thứ mấy trong Tuần

Hàm cho ra thứ mấy trong Tuần

Tuanktcdcn

1/ Function Thutrongtuan(ByVal bDate As Date) As String
Dim Thu(7)
Thu(1) = "Chủ Nhật"
Thu(2) = "Thứ hai"
Thu(3) = "Thứ ba"
Thu(4) = "Thứ tư"
Thu(5) = "Thứ năm"
Thu(6) = "Thứ sáu"
Thu(7) = "Thứ bảy"

Thutrongtuan = Thu(Weekday(bDate))
End Function

Workman

2/ Function Thutrongtuan(ByVal bDate As Date) As String
Dim Thu(7)
Thu(1) = ChrW(67)+ChrW(104)+ChrW(7911)+ChrW(32)+ChrW(78)+Ch rW(104)+ChrW(7853)+ChrW(116)
Thu(2) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(104)+C hrW(97)+ChrW(105)
Thu(3) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(98)+Ch rW(97)
Thu(4) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(116)+C hrW(432)
Thu(5) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(110)+C hrW(259)+ChrW(109)
Thu(6) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(115)+C hrW(225)+ChrW(117)
Thu(7) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(98)+Ch rW(7843)+ChrW(121)

Thutrongtuan = Thu(Weekday(bDate))
End Function

handung107 · 10/6/06

Hàm cho một tháng có bao nhiêu ngày

Hàm cho một tháng có bao nhiêu ngày

Tuanktcdcn

Function Ngaycuathang(ByVal bDate As Date) As Byte
Dim Namnhuan As Boolean
Dim NGAY As Byte, Thang As Byte
Namnhuan = ((Year(bDate) / 4 - Int(Year(bDate) / 4)) = 0)
MsgBox Namnhuan
Thang = Month(bDate)
If Thang = 4 Or Thang = 6 Or Thang = 9 Or Thang = 11 Then
NGAY = 30
ElseIf Thang = 2 Then
If Namnhuan Then
NGAY = 29
Else
NGAY = 28
End If
Else
NGAY = 31
End If
Ngaycuathang = NGAY
End Function

handung107 · 10/6/06

Hàm cho ngày cuối tháng

Tuanktcdcn

Hàm cho ngày cuối tháng (dd/mm/yyyy)

Mã:

Function NgayCuoiThang(ByVal bDate As Date) As Date
Dim NGAY As Byte

NGAY = Day(bDate)

NgayCuoiThang = bDate + (Ngaycuathang(bDate) - NGAY)

End Function

Hàm cho một chuỗi "Ngày xx tháng xx nam xxxx"

Mã:

Function NgayThangNam(ByVal bDate As Date) As String
Dim NGAY As Byte, Thang As Byte
Dim Nam As Integer
NGAY = Day(bDate)
Thang = Month(bDate)
Nam = Year(bDate)
NgayThangNam = "Ngày " & NGAY & " tháng " & Thang & " năm " & Nam
End Function

Hàm cho một chuỗi "Ngày xx tháng xx nam xxxx" cuối tháng

Mã:

Function NgayCuoiThangSTR(ByVal bDate As Date) As String
NgayCuoiThangSTR = NgayThangNam(NgayCuoiThang(bDate))
End Function

Hàm cho một chuỗi "Thứ - Ngày xx tháng xx nam xxxx"

Mã:

Function Thu_NTN(ByVal bDate As Date) As String
Thu_NTN = Thutrongtuan(bDate) & " - " & NgayThangNam(bDate)
End Function

Hàm cho một chuỗi "Thứ - Ngày xx tháng xx nam xxxx" cuối tháng

Mã:

Function Thu_NTN_EOM(ByVal bDate As Date) As String
Dim NgaycuoiTh As Date
NgaycuoiTh = NgayCuoiThang(bDate)
Thu_NTN_EOM = Thu_NTN(NgaycuoiTh)
End Function

'Bạn hãy copy tất cả các hàm trên, tạo một Module trong Excel rồi Paste (CTRL+V) là có thể dùng được cho chính file đó. Nếu muốn dùng cho tất cả các file trên máy thì phải tạo và cất về dạng Add-In (*.xla)
'Khi làm việc trên các Sheet bạn sử dụng các hàm dó theo các tình huống của mình.
Ứng dụng

Mã:

'A1 = Today()
'B1 = Thutrongtuan(A1)
'B1 = Ngaycuathang(A1)
'B1 = NgayCuoiThang(A1)
'B1 = NgayThangNam(A1)
'B1 = NgayCuoiThangSTR(A1)
'B1 = Thu_NTN(A1)
'B1 = Thu_NTN_EOM(A1)

PhanTuHuong · 16/6/06

Xếp hạng

Hàm xếp thứ hạng

Hàm này cho kết quả gần như tương tự hàm Rank() sẵn có trong Excel, tôi giới thiệu để các bạn tham khảo.

Mã:

Function Thuhang(Diem, Mang)
' Trong đó: Diem là giá trị đơn lẻ, có thể nằm trong hoặc nằm ngoài Mang. Mang là tập hợp dãy số ở dạng cột.
Socot = Selection.Rows.Count
i = 1
For Each Cell In Mang
If Cell > Diem Then
i = i + 1
Thuhang = i ' Cho Thứ hạng theo thứ tự từ cao xuống thấp
Else
Thuhang = 1
End If
Next
End Function

SA_DQ · 17/6/06

handung107 đã viết:
Hàm cho ra thứ mấy trong Tuần
Tuanktcdcn

1/ Function Thutrongtuan(ByVal bDate As Date) As String
Dim Thu(7)
Thu(1) = "Chủ Nhật"
Thu(2) = "Thứ hai"
Thu(3) = "Thứ ba"
Thu(4) = "Thứ tư"
Thu(5) = "Thứ năm"
Thu(6) = "Thứ sáu"
Thu(7) = "Thứ bảy"
2 Thutrongtuan = Thu(Weekday(bDate))
End Function

Chị Dung & tác giả cho biết hàm có thể như thế này không:

Mã:

2 [B]ThuTrongTuan = Choose( WeekDay( BDay)), "CN", "T2",. .  . ., "T7")[/B]

Workman

handung107 đã viết:
2/ Function Thutrongtuan(ByVal bDate As Date) As String
Dim Thu(7)
Thu(1) = ChrW(67)+ChrW(104)+ChrW(7911)+ChrW(32)+ChrW(78)+Ch rW(104)+ChrW(7853)+ChrW(116)
Thu(2) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(104)+C hrW(97)+ChrW(105)
Thu(3) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(98)+Ch rW(97)
Thu(4) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(116)+C hrW(432)
Thu(5) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(110)+C hrW(259)+ChrW(109)
Thu(6) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(115)+C hrW(225)+ChrW(117)
Thu(7) = ChrW(84)+ChrW(104)+ChrW(7913)+ChrW(32)+ChrW(98)+Ch rW(7843)+ChrW(121)
Thutrongtuan = Thu(Weekday(bDate))
End Function

Cũng sẽ tương tự như trên, nếu sau dòng định nghĩa biến Mảng Thu(7) ta gán lệnh
Thu(0) = ChrW(84) & ChrW(104) & ChrW(7913) & ChrW(32)
Thì các dòng lệnh từ Thu(2) . . . đến Thu(7) sẽ dễ đọc & theo dõi hơn!
(Thu(7) = Thu(0) & ChrW(98)+Ch rW(7843)+ChrW(121)

Pansy_flower · 17/6/06

DFIND() Ver 1.1

Lọc dữ liệu từ 2 Sheets

Cách làm việc của hàm như sau:

* Hàm đã được cài sẵn tại 'S0'!H2:K32 để đưa ra DSách học sinh loại giỏi từ các lớp & giới tính. Được trích xuất từ 2 Sheets "S3" & "S4"

* Khi bấm Combobox tại 'S3'!L2 để chọn phái tính & chọn lớp tại 'S3'!M2, cũng đồng thời kích hoạt Sub LocAdvance()

Kết quả hàm DFIND() sẽ được cập nhật ra ngay khi ta trở lại 'S0'

Dowload: clickhere

(Trích bài của anh SA_DQ)

Pansy_flower · 17/6/06

Tim và lấy giá trị thoả mãn nhiều đều kiện

CSDL là trường cấp 2 -3 tại bài #8 ( ở đây trường MaTinh - cột 7) các bạn tự thêm vô giúp)

Function Loc4DK(Sh1 As Object, Lop As String)
1 Dim K_Qua(1 To 30, 1 To 4) As Variant
2 Dim jZ As Integer, zJ As Integer
3 Application.ScreenUpdating = 0
For jZ = 1 To 999
5 If Sh1.Cells(jZ, 6) = Lop And Sh1.Cells(jZ, 5) = 0 And Mid(Sh1.Cells(jZ, 4), 4, 2) > "09" And Sh1.Cells(jZ, 7) = "08" Then
6 zJ = zJ + 1
7 K_Qua(zJ, 2) = Sh1.Cells(jZ, 3): K_Qua(zJ, 3) = Sh1.Cells(jZ, 4)
8 K_Qua(zJ, 4) = Sh1.Cells(jZ, 6): K_Qua(zJ, 1) = Sh1.Cells(jZ, 1)
9 End If
10 Next jZ
11 Loc4DK = K_Qua
End Function

Để nhận được kết quả ta chọn từ ô O1:R30 tại sheet 'S1' & nhập hàm tự tạo: =Loc4DK( A2:G989; K1) lên thanh CT & kết thúc bằng tổ hợp 3 fím sẽ cho kết quả các em HS nam ngụ tại TP HCM (có mã tỉnh = '08), có ngày sinh thuộc quí 4 theo lớp chọn từ ComboBox sẵn có trên S1 của CSDL.

Có nghĩa dùng Combo sẽ lọc được danh sách HS lần lượt từng lớp thoả 3 Đ/K còn lại nêu trên.

(Trích bài của anh SA_DQ)

ThanhThao · 27/7/06

Đề nghị các bạn có hàm nào hay thì post lên cho mọi người dùng nhé.

dvu58 · 24/7/07

Hàm tìm vị trí của ký tự "trắng" thứ n của 1 chuỗi

Mã:

Function RONGA(ByVal S As String, ByVal n As Integer)
' Tim vi tri cua ky tu trang thu n cua chuoi
    Dim i, j, m, l As Integer
    Dim c As Variant
    l = Len(Trim(S))
    j = 0
    m = 0
    For i = 1 To l
        c = Mid(Trim(S), i, 1)
        If (c = " ") Then
            j = j + 1
            If (j = n) Then
                m = i
            End If
        End If
    Next i
    RONGA = m
End Function

Lam_A0 · 25/7/07

Anh có thể nêu lên một vài ứng dụng của hàm này không? Em nghĩ khi viết một hàm nào đó, các anh chị thường xuất phát từ yêu cầu cụ thể của công việc. Nhiều khi em đọc hàm, hiểu được, nhưng chưa biết để làm gì, rồi quên mất. Nếu các anh chị có thể nêu lên các ứng dụng, em nghĩ mọi người sẽ hiểu sâu hơn, nếu phù hợp có thể sử dụng ngay được.
Thanks!

dvu58 · 25/7/07

Lam_A0 đã viết:
Anh có thể nêu lên một vài ứng dụng của hàm này không? Em nghĩ khi viết một hàm nào đó, các anh chị thường xuất phát từ yêu cầu cụ thể của công việc. Nhiều khi em đọc hàm, hiểu được, nhưng chưa biết để làm gì, rồi quên mất. Nếu các anh chị có thể nêu lên các ứng dụng, em nghĩ mọi người sẽ hiểu sâu hơn, nếu phù hợp có thể sử dụng ngay được.
Thanks!

Ừm! Lam_A0 thân.
Chẳng có gì đâu. Một hôm mình nghĩ rằng cần tạo ra cái hàm để tìm ký tự "trắng" cuối cùng trong 1 chuỗi (để có thể ứng dụng vào việc tách tên ra khỏi họ tên) mình gọi là ham RONG() (rỗng ấy mà!):

Function RONG(S)
' Tim vi tri cua ky tu trang cuoi cung trong chuoi
Dim i, j, l As Integer
l = Len(Trim(S))
j = 0
For i = 1 To l
c = Mid(S, i, 1)
If (c = " ") Then
j = i
End If
Next i
RONG = j
End Function

(kết hợp với hàm MID, sẽ tách được tên ra khỏi họ và tên)

Thế rồi, mình nghĩ nếu tách cả họ riêng, tách tên lót riêng nữa thì hay biết mấy, mình nghĩ : Thử làm thêm cái RONGA(s,n) này. Mình thử kết hợp vào để tách mỗi thứ 1 cái thì thấy: Ờ, cũng được - Tuy có vẻ hơi rừng, không chuyên nghiệp lắm đâu.

Bên cạnh đó, có thể dùng để ứng dụng một số việc khác cũng thấy đường được,... ừ thì giới thiệu rồi các bạn trên diễn đàn góp ý cho câu cú, kể cả giải thuật nữa cho gọn gọn, dễ hiểu ấy mà.

Thân.

digita · 25/7/07

Lam_A0 đã viết:
Anh có thể nêu lên một vài ứng dụng của hàm này không? Em nghĩ khi viết một hàm nào đó, các anh chị thường xuất phát từ yêu cầu cụ thể của công việc. Nhiều khi em đọc hàm, hiểu được, nhưng chưa biết để làm gì, rồi quên mất. Nếu các anh chị có thể nêu lên các ứng dụng, em nghĩ mọi người sẽ hiểu sâu hơn, nếu phù hợp có thể sử dụng ngay được.
Thanks!

Ứng dụng hàm này liên quan đến việc lấy nhanh dữ liệu trong 1 hàng chữ (string) khi dãy chữ có 1 thứ tự giống nhau & ta biết vị trí của phần dữ liệu cần lấy trong đó.

Chẳng hạn như khi nhập data từ txt/rtf file có vài chục ngàn dòng. Mỗi dòng có 1 phần dữ liệu ta muốn lấy.

Thí dụ "Cái máy model XX-XXX-XXX được bán với giá USD XXXXX ngày bán dd/mm/yyyy. Giá trị giá tiền và số máy thay đổi từng ô. Tuy vậy ta biết được là Số model là chử thứ 4 trong dãy string. Còn giá tiền là chử thứ 10 và loại tiền là thứ 9. Trong trường hợp này muốn lấy hàng loạt số model máy và giá tiền thì cần

1/ Dùng hàm trên để tìm ra vị trí chồ trắng thứ 4, 9 & 10.

2/ Tìm khoảng cách từ chử 4 dến 5, từ 10 đến 11 (loại tiền thì lúc nào cũng có 3 chử.

3/ Rồi sau đó dùng hàm Mid trong VBA để lấy data.

Lam_A0 · 25/7/07

To dvu58: Em mới học VBA nhưng phải thừa nhận chương trình của anh rất "không chuyên nghiệp". Từ cách copy đoạn code vào bài viết, đặt tên hàm và biến, đấy là em so sánh với các chương trình khác trên forum.

To digita: Nghe anh nói đến việc nhập data từ file txt/rtf, hiện tại em đang phải làm một chương trình đọc dữ liệu từ file .xls đang closed sang một file .txt. Việc đọc trong file .xls thì em làm được rồi, nhưng ghi vào file .txt thì vẫn chưa biết làm thế nào cả. Anh có hàm nào xử lý được vụ này không? Cám ơn anh nhiều!

digita · 25/7/07

Lam_A0 đã viết:
To digita: Nghe anh nói đến việc nhập data từ file txt/rtf, hiện tại em đang phải làm một chương trình đọc dữ liệu từ file .xls đang closed sang một file .txt. Việc đọc trong file .xls thì em làm được rồi, nhưng ghi vào file .txt thì vẫn chưa biết làm thế nào cả. Anh có hàm nào xử lý được vụ này không? Cám ơn anh nhiều!

Chào bạn Lam_A0,

Không rõ là ý bạn cần biết cách mở 1 txt file trong XL hay là save 1 file từ trong XL qua dạng txt.

Thôi thì trả lời luôn 2 cách nha.

Mở 1 txt file

Trong hộp thoại file open bạn cần vô hộp "File of type" dưới cùng & chọn All files *.* & OK. Sau đó XL sẽ mở cái Text import wizard để cho bạn chọn cách hiển thị text data trên XL bạn chọn 1 trong các option rồi bấm nút OK.

Save qua dạng text

Chọn Save As trong thanh menu rồi trong hộp Save as Type chọn Text rồi cho tên mới vào và bấm OK.

Chúc bạn thành công

Lam_A0 · 25/7/07

digita đã viết:
Mở 1 txt file

Trong hộp thoại file open bạn cần vô hộp "File of type" dưới cùng & chọn All files *.* & OK. Sau đó XL sẽ mở cái Text import wizard để cho bạn chọn cách hiển thị text data trên XL bạn chọn 1 trong các option rồi bấm nút OK.

Save qua dạng text

Chọn Save As trong thanh menu rồi trong hộp Save as Type chọn Text rồi cho tên mới vào và bấm OK.

Để em giải thích bài toán của em cho anh nhé. Bây giờ em đang ở một Active Workbook nào đó, em cần phải đọc một số dữ liệu tại một Workbook đang closed sau đó xuất các dữ liệu này ra một file .txt. Chương trình này em viết cho người sử dụng không có nhiểu kiến thức về Excel cũng như VBA, vì vậy thao tác càng đơn giản càng tốt. Dẫu sao từ hướng dẫn của anh em đã có ý tưởng để giải bài này rồi, có vấn đề gì em sẽ làm phiền anh tiếp nhỉ!
Cám ơn anh!

dvu58 · 25/7/07

Lam_A0 đã viết:
Để em giải thích bài toán của em cho anh nhé. Bây giờ em đang ở một Active Workbook nào đó, em cần phải đọc một số dữ liệu tại một Workbook đang closed sau đó xuất các dữ liệu này ra một file .txt. Chương trình này em viết cho người sử dụng không có nhiểu kiến thức về Excel cũng như VBA, vì vậy thao tác càng đơn giản càng tốt. Dẫu sao từ hướng dẫn của anh em đã có ý tưởng để giải bài này rồi, có vấn đề gì em sẽ làm phiền anh tiếp nhỉ!
Cám ơn anh!

Xin các bạn hãy quay lại chủ đề chính mà KDK đã đề xướng: "Mỗi tuần 1 hàm"

Các nội dung khác xin trình bày ở đề tài khác nhé.

dvu58 · 25/7/07

Lam_A0 đã viết:
To dvu58: Em mới học VBA nhưng phải thừa nhận chương trình của anh rất "không chuyên nghiệp". Từ cách copy đoạn code vào bài viết, đặt tên hàm và biến, đấy là em so sánh với các chương trình khác trên forum.

Cảm ơn Lam_A0, mình đã tự nhận là không chuyên nghiệp vì mình chưa từng được học VBA (hoặc là cà VB) bao giờ, mà chỉ lên diễn đàn học hỏi rồi tự thực hành. Nhưng cái quan trọng là nó đã giúp được chính mình trong công việc thực tế mà mình đang làm rất nhiều, nó cũng giúp cho mình thực hiện các ý tưởng muốn làm.

Nhân đây, mình cũng mong muốn diễn đàn tăng cường trao đổi có tính chất bài bản hơn về VBA. Mình rất thích ý tưởng của KDK về topic này.
Cũng rất cảm ơn KDK.

Nguyễn Duy Tuân · 26/7/07

Hàm Dao_Chuoi

Hàm đảo chuỗi "cực chuẩn" /-*+/

=Dao_Chuoi(" Năm ---- Ngày ----- Tháng ")
Kết quả là " Tháng ----- Ngày ---- Năm "

Mã:

Function Dao_Chuoi(ByVal Text As String) As String
On Error GoTo RaiseErr

Dim S As String, tmpText As String
Dim p1, p2, nLen, nSpace1, nSpace2

Dao_Chuoi = Text
tmpText = Trim(Text)
If tmpText = "" Then Exit Function

nSpace1 = 0
GetSpace1:
    If Mid(Text, nSpace1 + 1, 1) = " " Then
        nSpace1 = nSpace1 + 1
        GoTo GetSpace1
    End If
    
nLen = Len(Text)
nSpace2 = 0
GetSpace2:
    If Mid(Text, nLen - nSpace2, 1) = " " Then
        nSpace2 = nSpace2 + 1
        GoTo GetSpace2
    End If
    
tmpText = tmpText & " "
S = ""
p1 = 0
p2 = 1
Do While p2 > 0
    p2 = InStr(p1 + 1, tmpText, " ")
    If p2 > 0 Then
        If S = "" Then
            S = Mid(tmpText, p1 + 1, p2 - p1 - 1) & S
        Else
            S = Mid(tmpText, p1 + 1, p2 - p1) & S
        End If
       p1 = p2
    End If
Loop

Dao_Chuoi = Space(nSpace2) & S & Space(nSpace1)
Exit Function

RaiseErr:
'Dao_Chuoi="Error!"
End Function

Mỗi tuần một hàm VBA

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

VBA & VB.NET for Excel & AutoCad

/(hông là gì!

...nợ người, nợ đời...

...nợ người, nợ đời...

Thành viên mới

Thành viên thường trực

Thành viên hoạt động

Thành viên thường trực

digita

Guest

Thành viên hoạt động

digita

Guest

Thành viên hoạt động

Thành viên thường trực

Thành viên thường trực

Nghị Hách