Bài tập về code VBA (1 người xem)

today100506 · 24/4/14

[HUUDUCTRAN] CODE MẪU ! XEM & PHÁT TRIỂN ! UPDATE LIÊN TỤC

Xin chào anh chị,

Em xin lập topic này để đưa lên các code mẫu (có kèm file mẫu + code)

Mời anh chị vào xem

Nếu thấy chỗ nào chưa hay, chưa đúng, chưa hợp lý
anh chị cứ góp ý, cứ nói..., cứ sửa...thoải mái !

Em xin chân thành cảm ơn !

today100506 · 24/4/14

CODE #1 TÌM Ô CUỐI, DÒNG CUỐI, CỘT CUỐI

Mã:

[COLOR=#008000]'Note: Code mo^ phong? nen chi dung sub & msgbox xem ket qua
' khong de cap nen^ dung sub/ hay function o day ![/COLOR]
Sub FindCells()
    Dim rng As Range
    Dim rslt As Range
    Dim strTmp As String
    Dim iChoice As String

    iChoice = Application.InputBox(prompt:="iChoice:", Type:=2)
    
    With Cells[COLOR=#008000] 'tim` o cuoi[/COLOR]
        Select Case iChoice
            Case 1: [COLOR=#008000]'tim` hang` cuoi'[/COLOR]
                Set rslt = .Find(what:="*", _
                                    after:=.Cells(1, 1), _
                                    LookIn:=xlFormulas, _
                                    lookat:=xlPart, _
                                    searchorder:=xlRows, _
                                    searchdirection:=xlPrevious, _
                                    MatchCase:=False)
            Case 2: [COLOR=#008000]'tim` cot^. cuoi'[/COLOR]
                Set rslt = .Find(what:="*", _
                                    after:=.Cells(1, 1), _
                                    LookIn:=xlFormulas, _
                                    lookat:=xlPart, _
                                    searchorder:=xlColumns, _
                                    searchdirection:=xlPrevious, _
                                    MatchCase:=False)
            Case 3: [COLOR=#008000]'tim` o^ cuoi'[/COLOR]
                Set rslt = .Find(what:="*", _
                                    after:=.Cells(1, 1), _
                                    LookIn:=xlFormulas, _
                                    lookat:=xlPart, _
                                    searchorder:=xlRows, _
                                    searchdirection:=xlPrevious, _
                                    MatchCase:=False)
        End Select
        If rslt Is Nothing Then: Exit Sub[COLOR=#008000] 'catch error[/COLOR]
        firstAddress = rslt.Address
        Do
            Set rslt = .FindNext(rslt)
            strtmp = rslt.Address
        Loop While rslt.Address <> firstAddress
    End With
    
    Select Case iChoice
        Case 1: MsgBox Range(strtmp).Row
        Case 2: MsgBox Range(strtmp).Column
        Case 3: MsgBox Range(strtmp).Address
    End Select
End Sub

Tham khảo thêm: http://www.giaiphapexcel.com/diendan/threads/92924.Useful-functions-Các-hàm-hữu-ích-01 (levanduyet)

today100506 · 24/4/14

CODE #2 ĐIỀN DỮ LIỆU TỪ SHEET TỔNG VÀO TỪNG SHEET CON (THEO ĐIỀU KIỆN)

Mã:

Sub test()
    Dim rng As Range: Set rng = Range("a5:d209")
    Dim arr(1 To 1000, 1 To 1000)
    iRowFI = 3
    iRowIN1 = 3
    iRowIN2 = 3
    iRowPP = 3
    iRowTR12 = 3
    iRowTR34 = 3
    iRowTR56 = 3
    iRowTR78 = 3
    iRowTR910 = 3
    iRowTR1112 = 3
    
[COLOR=#008000]    'Step 1: record into array[/COLOR]
    For Each cll In rng.Columns("d").Cells
        i = i + 1
        arr(i, 1) = cll.Offset(0, -2).Value 'MaNV
        arr(i, 2) = cll.Offset(0, -1).Value 'TenNV
        arr(i, 3) = cll.Offset(0, -0).Value 'Chuyen
    Next cll
    
[COLOR=#008000]    'Step 2: write into valid sheets[/COLOR]
    On Error Resume Next
    For i = 1 To UBound(arr)
        Select Case arr(i, 3)
            Case "FI"
                On Error Resume Next
                Worksheets("FI").Cells(iRowFI, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("FI").Cells(iRowFI, 3).Value = arr(i, 1) '1=ma~
                Worksheets("FI").Cells(iRowFI, 4).Value = arr(i, 2) '2=hoten
                iRowFI = iRowFI + 5
                On Error GoTo 0
            Case "IN1"
                On Error Resume Next
                Worksheets("IN1").Cells(iRowIN1, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("IN1").Cells(iRowIN1, 3).Value = arr(i, 1) '1=ma~
                Worksheets("IN1").Cells(iRowIN1, 4).Value = arr(i, 2) '2=hoten
                iRowIN1 = iRowIN1 + 5
                On Error GoTo 0
            Case "IN2"
                On Error Resume Next
                Worksheets("IN2").Cells(iRowIN2, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("IN2").Cells(iRowIN2, 3).Value = arr(i, 1) '1=ma~
                Worksheets("IN2").Cells(iRowIN2, 4).Value = arr(i, 2) '2=hoten
                iRowIN2 = iRowIN2 + 5
                On Error GoTo 0
            Case "PP"
                On Error Resume Next
                Worksheets("PP").Cells(iRowPP, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("PP").Cells(iRowPP, 3).Value = arr(i, 1) '1=ma~
                Worksheets("PP").Cells(iRowPP, 4).Value = arr(i, 2) '2=hoten
                iRowPP = iRowPP + 5
                On Error GoTo 0
            Case "TR1,2"
                On Error Resume Next
                Worksheets("TR1,2").Cells(iRowTR12, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR1,2").Cells(iRowTR12, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR1,2").Cells(iRowTR12, 4).Value = arr(i, 2) '2=hoten
                iRowTR12 = iRowTR12 + 5
                On Error GoTo 0
            Case "TR3,4"
                On Error Resume Next
                Worksheets("TR3,4").Cells(iRowTR34, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR3,4").Cells(iRowTR34, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR3,4").Cells(iRowTR34, 4).Value = arr(i, 2) '2=hoten
                iRowTR34 = iRowTR34 + 5
                On Error GoTo 0
            Case "TR5,6"
                On Error Resume Next
                Worksheets("TR5,6").Cells(iRowTR56, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR5,6").Cells(iRowTR56, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR5,6").Cells(iRowTR56, 4).Value = arr(i, 2) '2=hoten
                iRowTR56 = iRowTR56 + 5
                On Error GoTo 0
            Case "TR7,8"
                On Error Resume Next
                Worksheets("TR7,8").Cells(iRowTR78, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR7,8").Cells(iRowTR78, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR7,8").Cells(iRowTR78, 4).Value = arr(i, 2) '2=hoten
                iRowTR78 = iRowTR78 + 5
                On Error GoTo 0
            Case "TR9,10"
                On Error Resume Next
                Worksheets("TR9,10").Cells(iRowTR910, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR9,10").Cells(iRowTR910, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR9,10").Cells(iRowTR910, 4).Value = arr(i, 2) '2=hoten
                iRowTR910 = iRowTR910 + 5
                On Error GoTo 0
            Case "TR11,12"
                On Error Resume Next
                Worksheets("TR11,12").Cells(iRowTR1112, 2).Value = arr(i, 3) '3=chuyen`
                Worksheets("TR11,12").Cells(iRowTR1112, 3).Value = arr(i, 1) '1=ma~
                Worksheets("TR11,12").Cells(iRowTR1112, 4).Value = arr(i, 2) '2=hoten
                iRowTR1112 = iRowTR1112 + 5
                On Error GoTo 0
        End Select
    Next i
End Sub

today100506 · 27/4/14

CODE #3 DUYỆT QUA TẤT CẢ THƯ MỤC TRONG MÁY TÍNH

Mã:

[COLOR=#008000]'Note:
'Code mau^~ mo^ phong? duyet^. qua tat' ca? cac' folders trong may' tinh
'cho nen, khi binh luan, cac' ban hay tap trung vao cach viet code nhe'

[/COLOR][COLOR=#0000ff]Sub[/COLOR] main()
    Call browseFoldersAZ
End Sub

[COLOR=#0000ff]Sub[/COLOR] browseFoldersAZ()
    Dim fso, drv, pathTextFile As Object
    Set fso = New Scripting.FileSystemObject
    Set drvs = fso.Drives
    Set pathTextFile = fso.CreateTextFile("C:\text.txt", overwrite:=True)
        pathTextFile.Close
    
    On Error Resume Next 'catch error
    
    For Each drv In drvs 'browse drives
        browseFolder (drv.RootFolder)
    Next drv
    
    Set pathTextFile = Nothing 'erase
    Set drv = Nothing
    Set fso = Nothing
End Sub

[COLOR=#0000ff]Sub [/COLOR]browseFolder(specFdr) 'browse folders
    Dim fso, fdr, sfdr As Object
    Set fso = New Scripting.FileSystemObject
    Set fdr = fso.GetFolder(specFdr)
    Set sfdr = fdr.SubFolders
        
    For Each fdr In sfdr
        Set pathTextFile = fso.OpenTextFile("C:\text.txt", IOMode:=ForAppending)
            pathTextFile.WriteLine (fdr.Path)
            pathTextFile.Close
        MsgBox fdr.Path
        browseFolder (fdr.Path)
    Next fdr
    
    Set sfdr = Nothing
    Set fdr = Nothing
    Set fso = Nothing
    
End Sub

today100506 · 4/5/14

[VBA] CODE #4 TỔNG HỢP CÁC CÁCH TÁCH HỌ VÀ TÊN BẰNG VBA
tham khảo thêm tại: http://www.giaiphapexcel.com/diendan/threads/92923.Tổng-hợp-các-phương-pháp-tách-họ-và-tên

PHẦN 1: TÁCH HỌ

Mã:

[COLOR=#008000]'XU LY CHUOI
'way 1: Su dung vong lap
'way 2: Su dung cac ham xu ly chuoi san co cua VBA
'way 3: Su dung cac ham xu ly chuoi san co cua WorksheetFunction
'
'NOTE:
'way3 con vuong mot vai cho chua xu ly duoc:
'     + xu ly nhu the nao voi cong thuc mang {Ctrl + Shift + Enter}
'     + chua giai quyet duoc cho^~ chua' cong thuc mang~ ROW($1:$50)trong cong thuc sau: _
'             Mid(Trim(strName),ROW($1:$50),1)=" " ...[/COLOR]

[COLOR=#008000]'XU LY CHUOI - FIRST PART - GROUP
[/COLOR]Sub test()
    Dim strName1, strName2, strName3, strName4, strChoice As String
    strName1 = "Linh"
    strName2 = "Thach Linh"
    strName3 = "Thach Thi Linh"
    strName4 = "Thach Thi Thao Linh"
    
    strChoice = "1"
    Call xulychuoi_dau1(strName4, strChoice)
    Call xulychuoi_dau1(strName3, strChoice)
    Call xulychuoi_dau1(strName2, strChoice)
    Call xulychuoi_dau1(strName1, strChoice)
End Sub

Function xulychuoi_dau1(ByVal strName As String, Optional ByVal choice As String = "1") As String
    Dim strTmp As String
    Dim length As Integer
    Dim wsf As WorksheetFunction
    
    Select Case choice
        Case "1": [COLOR=#008000]'way 1: Su dung vong lap[/COLOR]
            For i = 1 To Len(Trim(strName)) Step 1
                If mid(Trim(strName), i, 1) = " " Then: Exit For
                strTmp = strTmp & mid(Trim(strName), i, 1)
            Next i
        
        Case "2": [COLOR=#008000]'way 2: Su dung cac ham xu ly chuoi san co cua VBA[/COLOR]
            length = InStr(1, Trim(strName), " ", vbtextcomapre) - 1
            Select Case length
                Case -1: strTmp = strName
                Case Else: strTmp = Left(Trim(strName), length)
            End Select
        
        Case "3a" [COLOR=#008000]'way 3a: Su dung cac ham xu ly chuoi san co cua WorksheetFunction - left n ky tu[/COLOR]
            Set wsf = Application.WorksheetFunction
            On Error Resume Next
            length = wsf.Find(" ", Trim(strName), 1) - 1
            Select Case Err.Number
                Case 0: strTmp = Left(Trim(strName), length)
                Case 1004: strTmp = strName
                Case Else: strTmp = -9999 'new error code #
            End Select
            On Error GoTo 0

        Case "3b" [COLOR=#008000]'way 3b: Su dung cac ham xu ly chuoi san co cua WorksheetFunction - replace 'X'kytu -> ""[/COLOR]
            Dim intPosition As Integer
            Set wsf = Application.WorksheetFunction
            length = 50
            On Error Resume Next
            intPosition = wsf.Find(" ", Trim(strName), 1)
            Select Case Err.Number
                Case 0: strTmp = wsf.Replace(Trim(strName), intPosition, length, "")
                Case 1004: strTmp = strName
                Case Else: strTmp = -9999 'new error code #
            End Select
            On Error GoTo 0
        
        Case "3c" [COLOR=#008000]'way 3c: Su dung cac ham xu ly chuoi san co cua WorksheetFunction - Substitute ky tu 'X' -> "         [/COLOR]    "
            Set wsf = Application.WorksheetFunction
            strTmp = Trim(Left(wsf.Substitute(Trim(strName), " ", "                    "), 20))
        Case Else:
            strTmp = ""
    End Select
    
    xulychuoi_dau1 = strTmp
    
    MsgBox xulychuoi_dau1 & vbTab & Len(xulychuoi_dau1)

End Function

PHẦN II: TÁCH TÊN

Mã:

Sub test()
    Dim strName1, strName2, strName3, strName4, strChoice As String
    strName1 = "Linh"
    strName2 = "Thach Linh"
    strName3 = "Thach Thi Linh"
    strName4 = "Thach Thi Thao Linh"
    
    strChoice = "1"
    Call xulychuoi_cuoi1(strName4, strChoice)
    Call xulychuoi_cuoi1(strName3, strChoice)
    Call xulychuoi_cuoi1(strName2, strChoice)
    Call xulychuoi_cuoi1(strName1, strChoice)
End Sub

Function xulychuoi_cuoi1(ByVal strName As String, Optional ByVal choice As String) As String
    Dim strTmp As String
    Dim length As Integer
    
    Select Case choice
        Case "1" [COLOR=#008000]'way 1: Su dung vong lap[/COLOR]
            For i = Len(Trim(strName)) To 1 Step -1
                If mid(Trim(strName), i, 1) = " " Then: Exit For
                strTmp = mid(Trim(strName), i, 1) & strTmp
            Next i

        Case "2" [COLOR=#008000]'way 2: Su dung cac ham xu ly chuoi san co cua VBA[/COLOR]
            length = InStrRev(Trim(strName), " ", -1, vbTextCompare)
            strTmp = Right(Trim(strName), Len(Trim(strName)) - length)
        
        Case "3" [COLOR=#008000]'way 3: Su dung cac ham xu ly chuoi san co cua WorksheetFunction[/COLOR]
                    ' chua du kha nang xu ly...

        Case Else: strTmp = ""
    End Select
    
    xulychuoi_cuoi1 = strTmp
    
    MsgBox xulychuoi_cuoi1 & vbTab & Len(xulychuoi_cuoi1)

End Function

PHẦN III: TÁCH CHỮ LÓT

Mã:

Sub test()
    Dim strName1, strName2, strName3, strName4, strChoice As String
    strName1 = "Linh"
    strName2 = "Thach Linh"
    strName3 = "Thach Thi Linh"
    strName4 = "Thach Thi Thao Linh"
        
    strChoice = "1"
    Call xulychuoi_cuoi1(strName4, strChoice)
    Call xulychuoi_cuoi1(strName3, strChoice)
    Call xulychuoi_cuoi1(strName2, strChoice)
    Call xulychuoi_cuoi1(strName1, strChoice)
End Sub

Function xulychuoi_cuoi1(ByVal strName As String, Optional ByVal choice As String = "1") As String
    Dim strTmp As String
    Dim intStart, intEnd, length As Integer
        
    Select Case choice
        Case "1" [COLOR=#008000]'way 1: Su dung vong lap[/COLOR]
            For i = 1 To Len(Trim(strName)) Step 1
                If mid(Trim(strName), i, 1) = " " Then: intStart = i + 1: Exit For
            Next i
            For i = Len(Trim(strName)) To 1 Step -1
                If mid(Trim(strName), i, 1) = " " Then: intEnd = i - 1: Exit For
            Next i
            GoTo lxulychung:
            
        Case "2" [COLOR=#008000]'way 2: Su dung cac ham xu ly chuoi san co cua VBA[/COLOR]
            intStart = InStr(1, Trim(strName), " ", vbTextCompare) + 1
            intEnd = InStrRev(Trim(strName), " ", -1, vbTextCompare) - 1
            GoTo lxulychung:
            
        Case "3" [COLOR=#008000]'way 3: Su dung cac ham xu ly chuoi san co cua WorksheetFunction
                    ' chua du kha nang xu ly...[/COLOR]
        
        Case Else: strTmp = ""
    End Select
    
[COLOR=#0000ff]lxulychung:[/COLOR]
    Select Case intStart 'just intStart is enough
        Case 0: strTmp = "" 'one word
        Case Is > intEnd: strTmp = "" 'two word
        Case Else
            Select Case choice
                Case "1"
                    For i = intStart To intEnd Step 1 'catched error below !
                        strTmp = strTmp & mid(Trim(strName), i, 1)
                    Next i
                Case "2"
                    length = (intEnd - intStart) + 1
                    strTmp = mid(Trim(strName), intStart, length) 'catched error below !
            End Select
    End Select

        
    xulychuoi_cuoi1 = strTmp
    MsgBox xulychuoi_cuoi1 & vbTab & Len(xulychuoi_cuoi1)
End Function

SA_DQ · 4/5/14

Như tiêu đề topic bạn nêu là Code mẫu;

Vậy thì trong fần tách họ trong chuỗi họ tên ta nên đưa thêm hàm tách họ dựa vô hàm Intr() thay thế cho vòng lặp hiện hữu của bạn.

Như :

VTr = InStr( HoTen," ")
TachHo= Let(HoTen, VTr - 1)

Chúc bạn nhiều thành công hơn nữa!

today100506 · 5/5/14

HYen17 đã viết:
Như tiêu đề topic bạn nêu là Code mẫu;

Vậy thì trong fần tách họ trong chuỗi họ tên ta nên đưa thêm hàm tách họ dựa vô hàm Intr() thay thế cho vòng lặp hiện hữu của bạn.

Như :

VTr = InStr( HoTen," ")
TachHo= Let(HoTen, VTr - 1)

Chúc bạn nhiều thành công hơn nữa!

Chắc chắn, InStr là hàm tiếp theo mình sẽ nghiên cứu đến...
Do hiện tại, mình chưa biết sử dụng hàm InStr nên trong code mẫu chưa có, heheh,
Thanks bạn !
...
......
.........
Bây giờ là, 1:38 PM 5/5/2014, theo góp ý của bạn HYen17, mình đã update code mới, xin mời các bạn xem qua !

ChanhTQ@ · 5/5/14

Là mình thì bài #3 mình sẽ viết vầy:

PHP:

Option Base 1:                              Option Explicit
Sub ChamCong()
 Dim Arr():                                 Dim J4 As Long, J5 As Long, J6 As Long
 Dim Rws As Long, J As Long, VTr As Byte, J1 As Long, J2 As Long, J3 As Long
 Const ShN As String = "FI  IN1 IN2 TR12TR34TR56"
 
 Rws = [B5].CurrentRegion.Rows.Count
 Arr = [B5].Resize(Rws, 3).Value
 ReDim aFI(Rws, 3):                         ReDim aIN1(Rws, 3)
 ReDim aT12(Rws, 3):                        ReDim aIN2(Rws, 3)
 ReDim aT34(Rws, 3):                        ReDim aT56(Rws, 3)
 J1 = 1:            J2 = 1:                 J3 = 1
 J4 = 1:            J5 = 1:                 J6 = 1
 For J = 1 To UBound(Arr())
    VTr = InStr(ShN, Arr(J, 3))
    Select Case VTr
    Case 1
        aFI(J1, 1) = Arr(J, 3)
        aFI(J1, 2) = Arr(J, 1):             aFI(J1, 3) = Arr(J, 2)
        J1 = 5 + J1
    Case 5
        aIN1(J2, 1) = Arr(J, 3)
        aIN1(J2, 2) = Arr(J, 1):            aIN1(J2, 3) = Arr(J, 2)
        J2 = 5 + J2
    Case 9
        aIN2(J3, 1) = Arr(J, 3)
        aIN2(J3, 2) = Arr(J, 1):            aIN2(J3, 3) = Arr(J, 2)
        J3 = 5 + J3
    Case 13
        aT12(J4, 1) = Arr(J, 3)
        aT12(J4, 2) = Arr(J, 1):            aT12(J4, 3) = Arr(J, 2)
        J4 = 5 + J4
    Case 17
        aT34(J5, 1) = Arr(J, 3)
        aT34(J5, 2) = Arr(J, 1):         aT34(J5, 3) = Arr(J, 2)
        J5 = 5 + J5
    Case 21
        aT56(J6, 1) = Arr(J, 3)
        aT56(J6, 2) = Arr(J, 1):         aT56(J6, 3) = Arr(J, 2)
        J6 = 5 + J6
    End Select
 Next J
 Sheets("FI").[b3].Resize(Rws, 3) = aFI()
 Sheets("IN1").[b3].Resize(Rws, 3) = aIN1()
 Sheets("IN2").[b3].Resize(Rws, 3) = aIN2()
 Sheets("TR12").[b3].Resize(Rws, 3) = aT12()
 Sheets("TR34").[b3].Resize(Rws, 3) = aT34()
 Sheets("TR56").[b3].Resize(Rws, 3) = aT56()
 
End Sub

(3 trang tính sau mình đã đổi tên)

sealand · 5/5/14

Em thấy Bác ChanhTQ@ cũng vẫn còn dài. Em thấy nếu chỉ chép (Vì chưa có đoạn xoá DL cũ) thì như sau cũng ổn:

Mã:

Sub STest()
Dim Tmp, i, j
Const StrName = "FI;TR1,2;IN1,IN2;TR5,6;TR3,4"
Tmp = Sheet1.Range("A5:D" & Sheet1.[A65536].End(3).Row)
For i = 1 To UBound(Tmp, 1)
If InStr(1, StrName, Tmp(i, 4)) > 0 Then
With ThisWorkbook.Worksheets(Tmp(i, 4))
For j = 3 To 65000 Step 5
If .Cells(j, 1) = "" Then
.Cells(j, 1) = Int(j / 5) + 1
.Cells(j, 2) = Tmp(i, 4)
.Cells(j, 3) = Tmp(i, 2)
.Cells(j, 4) = Tmp(i, 3)
Exit For
End If
Next j
End With
End If
Next i
End Sub

today100506 · 5/5/14

[VBA] CODE #5 TỔNG HỢP CÁC CÁCH KIỂM TRA FILE CÓ TỔN TẠI ?
VỚI KHẢ NĂNG HIỆN TẠI, MÌNH CHỈ LÀM ĐƯỢC NHƯ NÀY.
SAU NÀY MÌNH SẼ BỔ SUNG THÊM...!

Mã:

Sub test()
Dim strFilename, strChoice As String
strFilename = "C:\test\test.xlsx"

strChoice = "1"
MsgBox func_isFileExists(strFilename, strChoice)
End Sub

Function func_isFileExists(ByVal strFilename As String, Optional ByVal strChoice As String = "1") As Boolean
    Dim intErrNum As Integer
    Dim objFile As file
    Dim objFSO As FileSystemObject
    
    On Error Resume Next [COLOR=#008000]'catch error[/COLOR]
        Select Case strChoice
            Case "1" [COLOR=#008000]'way 1: open/ close --> get err.number[/COLOR]
                    Open strFilename For Input Lock Read As #1
                    Close 1
                    intErrNum = Err.Number
            Case "2" [COLOR=#008000]'way 2: getFile (fso) --> get err.number
[/COLOR]                Set objFSO = CreateObject("scripting.filesystemobject")
                Set objFile = objFSO.GetFile(strFilename)
                intErrNum = Err.Number
            Case Else: 'default ("1")
                Open strFilename For Input Lock Read As #1
                Close 1
                intErrNum = Err.Number
        End Select
    On Error GoTo 0
    
    Select Case intErrNum
        Case 0: func_isFileExists = True [COLOR=#008000]'file exists[/COLOR]
        Case 55: func_isFileExists = True [COLOR=#008000]'file already open[/COLOR]
        Case 70: func_isFileExists = True [COLOR=#008000]'permission denied[/COLOR]
        Case 53: func_isFileExists = False [COLOR=#008000]'file not found[/COLOR]
        Case Else: func_isFileExists = -9999 [COLOR=#008000]'new error code #[/COLOR]
    End Select
    
    Set objFile = Nothing
    Set objFSO = Nothing
End Function

today100506 · 5/5/14

[VBA] CODE #6 TỔNG HỢP CÁC CÁCH KIỂM TRA FILE ĐANG MỞ (isFileOpenning)

VỚI KHẢ NĂNG HIỆN TẠI, MÌNH CHỈ LÀM ĐƯỢC NHƯ NÀY.
SAU NÀY MÌNH SẼ BỔ SUNG THÊM...!

Code thứ 1: Có thể check mọi loại file (isFileOpenning)

Mã:

[COLOR=#008000]'way to process this problem:
'step 1: check it exists (isFileExists)
'step 2: if exists, continuous... check it openning (func_isFileOpenning)
'
'*Note:
'Khi check thuc te thi gap phai van de nhu the nay:
'     step 1: Minh tu?. mo? san file "C:\test\test.xlsx"
'     step 2: check func_isFileOpenning, thi no' ko hieu la file da~ open ???
'        Open strFilename For Input Lock Read As #intFilenum
' co' phai la do khi minh tu?. mo? file, va khi chay lenh no' mo? file, _
' so #intFileNum khac nhau, nen no' ko hieu ???
[/COLOR]
Sub test()
Dim strFilename, strChoice As String
strFilename = "C:\test\test.xlsx"

strChoice = "1"
MsgBox func_isFileOpenning(strFilename, strChoice)
End Sub

[COLOR=#008000]'(2) func_isFileOpenning ?
[/COLOR]Function func_isFileOpenning(ByVal strFilename As String, Optional ByVal strChoice As String) As Boolean
    Dim intErrNum, intFilenum As Integer
    intFilenum = FreeFile()
    
    If Not func_isFileExists(strFilename, strChoice) Then: MsgBox "File not exists !": Exit Function
    
    On Error Resume Next 'catch error
        Open strFilename For Input Lock Read As [COLOR=#0000ff]#intFilenum[/COLOR]
        Close intFilenum
        intErrNum = Err.Number
    On Error GoTo 0
    
    Select Case intErrNum
        Case 55: func_isFileOpenning = True [COLOR=#008000]'file already open
[/COLOR]        Case Else: func_isFileOpenning = False
    End Select
End Function

[COLOR=#008000]'(1) isFileExists ?
[/COLOR]Function func_isFileExists(ByVal strFilename As String, Optional ByVal strChoice As String = "1") As Boolean
    Dim intErrNum, intFilenum As Integer
    Dim objFile As file
    Dim objFSO As FileSystemObject
    intFilenum = FreeFile()
    
    On Error Resume Next 'catch error
        Select Case strChoice
            Case "1" 'way 1: open/ close --> get err.number
                    Open strFilename For Input Lock Read As #intFilenum
                    Close intFilenum
                    intErrNum = Err.Number
            Case "2" 'way 2: getFile (fso) --> get err.number
                Set objFSO = CreateObject("scripting.filesystemobject")
                Set objFile = objFSO.GetFile(strFilename)
                intErrNum = Err.Number
            Case Else: 'default ("1")
                Open strFilename For Input Lock Read As #intFilenum
                Close intFilenum
                intErrNum = Err.Number
        End Select
    On Error GoTo 0
    
    Select Case intErrNum
        Case 0: func_isFileExists = True 'file exists
        Case 55: func_isFileExists = True 'file already open
        Case 70: func_isFileExists = True 'permission denied
        Case 53: func_isFileExists = False 'file not found
        Case Else: func_isFileExists = -9999 'new error code #
    End Select
    
    Set objFile = Nothing
    Set objFSO = Nothing
End Function

Code thứ 2: Dành check riêng cho file excel (isXlFileOpenning)
Cách này, lúc em chập chững lộm cộm VBA, pác ndu96081631 hướng dẫn cho em...!

Mã:

[COLOR=#008000]'way to process this problem:
'very easy...
'Trong truong hop nay, ta giai quyet nhu sau:
'chi can biet' file excel do' co mo~ len hay chua
'khong can biet' no' co ton^` tai hay khong^(isFileExists?)

[/COLOR]Sub test()
Dim strFilename As String
strFilename = "C:\test\test.xlsx"

MsgBox func_isXlFileOpenning(strFilename)
End Sub

Function func_isXlFileOpenning(ByVal strFilename As String) As Boolean
    Dim intLength As Integer
    Dim strName As String
        
[COLOR=#008000]    'process string: get name[/COLOR]
    intLength = Len(Trim(strFilename)) - InStrRev(Trim(strFilename), "\", -1, vbTextCompare)
    strName = Right(Trim(strFilename), intLength)

    On Error Resume Next [COLOR=#008000]'catch error[/COLOR]
        func_isXlFileOpenning =[COLOR=#0000ff] CBool(Len(Workbooks(strName).name))[/COLOR]
    On Error GoTo 0
End Function

ndu96081631 · 5/5/14

Bạn nói rằng:

today100506 đã viết:
VỚI KHẢ NĂNG HIỆN TẠI, MÌNH CHỈ LÀM ĐƯỢC NHƯ NÀY.
SAU NÀY MÌNH SẼ BỔ SUNG THÊM...!

Vậy thì sao gọi là code mẫu GPE được nhỉ?
Mẫu là chuẩn mực để mọi người học hỏi. Vậy nên tôi nghĩ topic này chỉ nên xem là nơi để góp ý và hoàn thiện những gì bạn đã làm được mà thôi
(Nói chung, gọi là MẪU thì hơi quá)

today100506 · 5/5/14

ndu96081631 đã viết:
Bạn nói rằng:

Vậy thì sau gọi là code mẫu GPE được nhỉ?
Mẫu là chuẩn mực để mọi người học hỏi. Vậy nên tôi nghĩ topic này chỉ nên xem là nơi để góp ý và hoàn thiện những gì bạn đã làm được mà thôi
(Nói chung, gọi là MẪU thì hơi quá)

Em xin chào pác ndu96081631,

Thật ra, cái tên topic đầu tiên em đặt là:

[HUUDUCTRAN] CODE MẪU ! XEM & PHÁT TRIỂN ! UPDATE LIÊN TỤC

Nhưng em không biết thành viên nào trong BQT đã sửa lại cho em cái tên mới này,

uhm thì sửa..., em cũng xin vâng !

Một lần nữa, cảm ơn pác ndu đã quan tâm đến topic này !

Trân Trọng & kính chào !

ndu96081631 · 5/5/14

today100506 đã viết:
Em xin chào pác ndu96081631,

Thật ra, cái tên topic đầu tiên em đặt là:

[HUUDUCTRAN] CODE MẪU ! XEM & PHÁT TRIỂN ! UPDATE LIÊN TỤC

Nhưng em không biết thành viên nào trong BQT đã sửa lại cho em cái tên mới này,

uhm thì sửa..., em cũng xin vâng !

Một lần nữa, cảm ơn pác ndu đã quan tâm đến topic này !

Trân Trọng & kính chào !

Thật ra cũng chỉ góp ý thế thôi (theo ý kiến cá nhân tôi) chứ sửa hoặc không sửa cũng là quyền của bạn. Vả lại, bạn cũng không thể tự sửa tiêu đề (chỉ có BQT mới làm được)
Mà nếu phải sửa lại tiêu đề thì tôi cũng chẳng biết phải sửa thế nào cho đúng
???

ptm0412 · 5/5/14

today100506 đã viết:
Em xin chào pác ndu96081631,
Thật ra, cái tên topic đầu tiên em đặt là:

[HUUDUCTRAN] CODE MẪU ! XEM & PHÁT TRIỂN ! UPDATE LIÊN TỤC

Nhưng em không biết thành viên nào trong BQT đã sửa lại cho em cái tên mới này,

Cái tiêu đề ban đầu của bạn "kêu" quá, nếu không nói là câu view, nên tôi sửa. Tôi sửa 1 lúc cả 3 topic "kêu" đùng đùng như vậy.

Còn topic này: Trong vài bài đầu, tôi thấy bạn có để link đến các bài viết có sẵn, cụ thể là bài của LevanDuyet và hoangdanh282, nên nghĩ đó là code mẫu cũa GPE thật, vì Code của LevanDuyet và hoangdanh282 xứng đáng gọi là code mẫu.

Những bài sau đó bạn đưa code của bạn lên, vậy thì không còn là code mẫu nữa. Giờ tôi biết sửa sao đây?

SA_DQ · 5/5/14

[thongbao] Giờ thì không còn là code mẫu nữa. [/thongbao]

Thì sửa lại là những mẫu code! /(hà, Khà, khà,. . . . Cần fát triển liên tục

VetMini · 6/5/14

Ý của bạn muốn học hỏi thì đưa 1 bài code lên rồi nhờ người ta góp ý. Ít nhất cũng một mớ sửa đổi rồi mới sang bài khác.

Bạn đưa liên tiếp một đống tả pí lù. Cái thì tự viết, cái cóp ở đâu dó. Chả có trật tự, chả có phạm vi tiêu đề gì cả.
Rốt cuộc lại thì người muốn phê bình cũng ngán mà người muốn học hỏi cũng loạn óc hết.

Tôi nghĩ có thể chính bạn cũng chả biết code mẫu dùng để làm gì.
Trả lời gợi ý: người học code lập ra một đống file codeABC.bas (file text). Mỗi file là một module có tên liên hệ tới phạm vi công việc. Một khi code đã được cho là "tốt" rồi thì người ta chọn đúng file, nhét nó vào để dành. Cái đó dân trong nghề gọi là thư viện code hay code mẫu. Khi cần vào một vấn đề gì đó, người ta lôi đám thư viện này ra, xem cái nào đúng thì import vào project của mình. Nếu không có thì tìm cái gần nhất và sửa.
Đó là lý do tại sao khi viết code người ta luôn luôn ghi chú. Bởi vì không có ghi chú thì nửa năm sau, đọc lại code chả hiểu nó làm cái gì.

siwtom · 6/5/14

ptm0412 đã viết:
Cái tiêu đề ban đầu của bạn "kêu" quá, nếu không nói là câu view, nên tôi sửa. Tôi sửa 1 lúc cả 3 topic "kêu" đùng đùng như vậy.

Còn topic này: Trong vài bài đầu, tôi thấy bạn có để link đến các bài viết có sẵn, cụ thể là bài của LevanDuyet và hoangdanh282, nên nghĩ đó là code mẫu cũa GPE thật, vì Code của LevanDuyet và hoangdanh282 xứng đáng gọi là code mẫu.

Những bài sau đó bạn đưa code của bạn lên, vậy thì không còn là code mẫu nữa. Giờ tôi biết sửa sao đây?

Thì sửa thành "Code gửi phụ mẫu GPE" thôi

today100506 · 6/5/14

ptm0412 đã viết:
Cái tiêu đề ban đầu của bạn "kêu" quá, nếu không nói là câu view, nên tôi sửa. Tôi sửa 1 lúc cả 3 topic "kêu" đùng đùng như vậy.

Còn topic này: Trong vài bài đầu, tôi thấy bạn có để link đến các bài viết có sẵn, cụ thể là bài của LevanDuyet và hoangdanh282, nên nghĩ đó là code mẫu cũa GPE thật, vì Code của LevanDuyet và hoangdanh282 xứng đáng gọi là code mẫu.

Những bài sau đó bạn đưa code của bạn lên, vậy thì không còn là code mẫu nữa. Giờ tôi biết sửa sao đây?

Em xin cảm ơn BQT & các member lão thành đã góp ý, quan tâm đến các bài viết của em.

Em xin có ý kiến một tý về phát ngôn sau của thầy ptm0412 (chỉ là suy nghĩ, em ko có ý gì khác đâu nhé thầy ptm)

Cái tiêu đề ban đầu của bạn "kêu" quá, nếu không nói là câu view...

Thật ra, lúc em đặt tên, em chỉ nghĩ đơn giản thế này:
1. Cái em đưa lên là code --> nên em gọi đó là code mẫu !
2. Em cho đi tất cả, em đưa lên vừa để cho mọi người xem & vừa học hỏi thêm nếu có ai góp ý --> nên em đặt tiếp là "Xem & Phát triển !
3. Bài topic luôn được em up code lên thường xuyên --> nên em để thêm vô là "Update liên tục"

Cho nên, từ (1), (2) và (3) ==>> cái tên em đặt cho topic nó có dáng vẻ như thế này:

"Code mẫu ! Xem & Phát triển ! Update liên tục !

Ý của em chỉ là đặt một cái tên đơn giản và thực tế, chứ em đâu có cần câu view câu viết làm gì...

Có thể thầy ptm0412 đã hiểu lầm em...Nhưng thành thật, em xin cảm ơn thầy vì thầy đã quan tâm đến topic ! Thật sự !

Cái ngày mà em hỏi pác ndu các viết code vba "kiểm tra file có tồn tại" là cái ngày em bắt đầu học VBA,
Từ ngày em chập chững viết code đến giờ, chắc cũng mười mươi bữa rồi,
Mong được thầy ptm0412 và các anh chị chỉ bảo tận tình trong con đường sắp tới của em...

Trân trọng & Kính chào !

today100506 · 6/5/14

[VBA] CODE #7 HÀM TỰ TẠO - fTrim (HOẠT ĐỘNG NHƯ TRIM)

Mã:

[SIZE=3]Function fTrim(ByVal str As String) As String
    Dim i, iStart, iEnd, iLength As Integer
    
    i = 1 [COLOR=#008000]'get start position[/COLOR]
    Do Until mid(str, i, 1) <> " "
        i = i + 1
    Loop
    iStart = i
    
    If iStart > Len(str) Then: Exit Function [COLOR=#008000]'catch error: string only {spacebar} character[/COLOR]
    
    i = Len(str) [COLOR=#008000]'get end position[/COLOR]
    Do Until mid(str, i, 1) <> " "
        i = i - 1
    Loop
    iEnd = i
        
    iLength = iEnd - iStart + 1
    [COLOR=#0000ff]fTrim = mid(str, iStart, iLength)
[/COLOR]End Function[/SIZE][B][SIZE=3]
[/SIZE][/B]

ndu96081631 · 6/5/14

today100506 đã viết:
[VBA] CODE #7 HÀM TỰ TẠO - fTrim (HOẠT ĐỘNG NHƯ TRIM)

Tôi thắc mắc: Bạn nói fTrim hoạt động như TRIM là như cái gì? Như TRIM trên bảng tính hay như TRIM trong VBA?
Xem kết quả thì có vẻ giống như TRIM trong VBA. Vậy sao không là vầy:

Mã:

Function fTrim(ByVal str As String) As String
    fTrim = Trim(str)
End Function

Khó hiểu thật!
(hay bạn có ý gì khác?)

today100506 · 6/5/14

ndu96081631 đã viết:
Tôi thắc mắc: Bạn nói fTrim hoạt động như TRIM là như cái gì? Như TRIM trên bảng tính hay như TRIM trong VBA?
Xem kết quả thì có vẻ giống như TRIM trong VBA. Vậy sao không là vầy:

Mã:

Function fTrim(ByVal str As String) As String fTrim = Trim(str) End Function

Khó hiểu thật!
(hay bạn có ý gì khác?)

Dạ, thưa thầy ndu,
Ý của em là viết lại một hàm nào đó đã có, ví dụ trong code này, là viết lại một hàm hoạt động như Trim

Mục đích ở đây chỉ là học hỏi và trao dồi thêm kinh nghiệm !

+ Đối với em: khi viết lại hàm, là em vừa ôn lại kiến thức hàm, vừa phân tích, suy nghĩ, bắt lỗi...và phát triển khả năng viết code.

+ Đối với các bạn mới: Em sẽ cho các bạn thấy viết một hàm là như thế nào: ta phải phân tích, test thử tất cả các tính huống có thể xảy ra khi tự viết một hàm và bắt lỗi chúng, để khi đưa vào sử dụng thực tế, nó khả dụng ! v.v....

Em không muốn, một ngày đẹp trời nào đó, em muốn làm một việc gì đó, mà vba chưa có sẵn hàm đó cho em làm...
thì em còn biết đường mà viết một hàm... ^_^

ndu96081631 · 6/5/14

today100506 đã viết:
Dạ, thưa thầy ndu,
Ý của em là viết lại một hàm nào đó đã có, ví dụ trong code này, là viết lại một hàm hoạt động như Trim

Mục đích: Viết lại vừa có thể học hỏi, vừa hiểu thêm hàm, vừa phát triển cách viết hàm... ý em là thế đấy ạ !

Nếu bạn nói vậy thì topic này chắc phải sửa thành: BÀI TẬP VỀ CODE VBA quá
(bài tập thì muốn làm gì chẳng được, đúng sai tính sau)

SA_DQ · 6/5/14

Nếu bạn nói vậy thì topic này chắc phải sửa thành: BÀI TẬP VỀ CODE VBA quá
(bài tập thì muốn làm gì chẳng được, đúng sai tính sau)

Thì mần luôn đi, để lâu hóa bùn mất thôi!

thanhlanh · 6/5/14

Code kiểm tra file Excel đã mở hay chưa (bài #11) nếu file chứa code và file cần kiểm tra được mở bằng 2 session khác nhau thì coi như tèo (false). Chưa thể gọi là code mẫu được.

---------------------------------------------------------------
Bạn nói rằng bạn mới học code "mười mươi bữa" mà tôi nhìn chữ ký bạn thật kêu, kinh!

sealand · 7/5/14

today100506 đã viết:
[HUUDUCTRAN] CODE MẪU ! XEM & PHÁT TRIỂN ! UPDATE LIÊN TỤC

Xin chào anh chị,

Em xin lập topic này để đưa lên các code mẫu (có kèm file mẫu + code)

Mời anh chị vào xem

Nếu thấy chỗ nào chưa hay, chưa đúng, chưa hợp lý
anh chị cứ góp ý, cứ nói..., cứ sửa...thoải mái !

Em xin chân thành cảm ơn !

Mình xin có 1 ý kiến nhỏ về loạt Topic của Today100506 như sau:
Khi đã nói đến mẫu thì cái đó phải chuẩn mực đại diện cho hàng loạt các đối tượng đồng loại. Vậy mà Code của bạn còn đang tập viết và xin ý kiến thì không thể nói là mẫu được.
Mình cũng nói thêm, Code do anh Duyệt hay HoangDanh viết gửi lên GPE cũng không thể gọi là mẫu được vì như vậy sẽ không đánh giá đúng cái Tâm và cái Tầm của các anh ấy. Khi viết bài hướng dẫn nhau, trợ giúp nhau có thể còn tồn tại nhiều thứ, thiếu chỉnh trang rõ ràng xúc tích. Các bạn thấy các bài có tính mô phạm thì các anh ấy cũng như anh Tuấn "Nghị Hách" và 1 số cao thủ khác viết nó rõ ràng thậm chí còn giải thích cũng như chỉnh trang xịn như hàng Bill Gate ấy chứ.

Trong khi đó GPE là 1 diễn đàn khoa học và nghiêm túc trên mạng Internet được viếng thăm không chỉ có thành viên chúng ta mà có cả các khách thăm khác (Thậm chí là người nước ngoài vào tham khảo). Vậy việc đặt tiêu đề hay ngôn ngữ viết bài làm sao thể hiện được cái CHÂN của nó, ngược lại dễ bị bỏ qua khi nghe tên quá kêu mà bài không đúng vậy thì cũng ít người đủ kiên nhẫn đọc đến bài cuối.
Mong chủ Topic xem lại.

SA_DQ · 7/5/14

/(/hưng như trên đã nói: Người dân không thể tự sửa tiêu đề của mình hay của người khác được!

Lần cuối xin đề nghị các SMOD hãy thảo luận & cho 1 tiêu đề loạt bài này cho thích hợp hơn./.

ndu96081631 · 7/5/14

Thật ra tiêu đề gì cũng không sao (miễn phù hợp với nội quy). Vấn đề ở đây là cái tiêu đề CODE MẪU GPE có thể khiến các thành viên ngộ nhận, tưởng rằng đây là code chuẩn mực từ GPE, dẫn đến khi họ áp dụng có trục trặc gì đó rồi lại đổ tội cho GPE ta. Thậm chí nếu chỉ là CODE MẪU cũng chưa thể chấp nhận được
Từ lý do trên, tôi quyết định sửa tiêu đề lại thành BÀI TẬP VỀ CODE VBA
Nếu các bạn và BQT không có ý kiến gì khác thì ta thống nhất thế nhé!
Cảm ơn!
ANH TUẤN
(chúng ta có thể thảo luận thêm về các code của tác giả, đánh giá tính chính xác, hay, dở hoặc đưa lên thêm những đoạn code khác)

ChanhTQ@ · 7/5/14

Rất cảm ơn SMOD!

Vậy mình xin góp 1 bài tạp làm lịch tháng:

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Dat0 As Date, Dat As Date
 Dim Ngay As Byte, Thu As Long, J As Byte, Ww As Byte
 
 If Not Intersect(Target, [S1]) Is Nothing Then
    Dat = DateSerial([u1].Value, Target.Value, 1)
    Thu = Weekday(Dat)
    If Thu < 3 Then
        Ngay = Switch(Thu = 1, 6, Thu = 2, 0)
    Else
     Ngay = Thu - 2
    End If
    Dat0 = Dat - Ngay:                          [P3].Resize(6, 7).Clear
    For J = 3 To 8
        For Ww = 0 To 6
            With Cells(J, 16).Offset(, Ww)
                If (Month(Dat0) < [S1].Value) Xor (Month(Dat0) = 12 And [S1].Value = 1) Then
                Else
                    .Value = Dat0
                End If
                .NumberFormat = "DD"
            End With
            Dat0 = Dat0 + 1
            If [S1].Value > 1 Then
                If Month(Dat0) > [S1].Value Then Exit Sub
            Else
                If Day(Dat0) = 1 And Month(Dat0) = 2 Then Exit Sub
            End If
        Next Ww
    Next J
 End If
End Sub

today100506 · 7/5/14

ndu96081631 đã viết:
Thật ra tiêu đề gì cũng không sao (miễn phù hợp với nội quy). Vấn đề ở đây là cái tiêu đề CODE MẪU GPE có thể khiến các thành viên ngộ nhận, tưởng rằng đây là code chuẩn mực từ GPE, dẫn đến khi họ áp dụng có trục trặc gì đó rồi lại đổ tội cho GPE ta. Thậm chí nếu chỉ là CODE MẪU cũng chưa thể chấp nhận được
Từ lý do trên, tôi quyết định sửa tiêu đề lại thành BÀI TẬP VỀ CODE VBA
Nếu các bạn và BQT không có ý kiến gì khác thì ta thống nhất thế nhé!
Cảm ơn!
ANH TUẤN
(chúng ta có thể thảo luận thêm về các code của tác giả, đánh giá tính chính xác, hay, dở hoặc đưa lên thêm những đoạn code khác)

Tuy em không phải là người khởi sướng cái tên topic "Code mẫu GPE"
Nhưng em cũng bị vạ lây, các pác tranh luận sôi nổi quá, hihi...

Giờ thì cái topic của em đã có một cái tên rồi, em xin cảm ơn !

Nào anh chị, hãy vào góp ý, post code lên nào....

VetMini · 7/5/14

Tôi đã có khuyên tác giả hãy bình tĩnh, từ tốn nhưng có vẻ không si nhê ghì cả.

Bởi vậy tôi chỉ cảnh báo cho "các bạn mới" điều này:

today100506 đã viết:
...
+ Đối với các bạn mới: Em sẽ cho các bạn thấy viết một hàm là như thế nào: ta phải phân tích, test thử tất cả các tính huống có thể xảy ra khi tự viết một hàm và bắt lỗi chúng, để khi đưa vào sử dụng thực tế, nó khả dụng ! v.v....

Với trình độ người viết code cái hàm fTrim này, và với cách phân giải cũng như cách viết code; câu này là quá sức tự đại. "test thử tất cả các tính huống" là trình độ tương đối cao, nó đòi hỏi hiểu biết về kỹ thuật test và kỹ thuật phân tích.

Sự luộm thuộm của fTrim:
- Khai báo biến bừa bãi. Tuy biết kiểu cần dùng của nó (Integer) nhưng vẫn khai theo kiểu Variant
- Không biết tiết kiệm biến. Tiện đâu xài đó rồi chuyển sang nơi trữ khác.
- Exit Function trước khi gán trị -> code nguy hiểm. Tuy không gán thì string mặc định là "" nhưng theo nguyên tắc thì vẫn là cách code cẩu thả.
Sự yếu kém về giải thuật của fTrim:
- Gọi hàm LEN những 2 lần. Theo nguyên tắc, nếu chuỗi khôg thay đổi thì code phải làm thế nào để gọi hàm định tính chất càng ít càng tốt (LEN là một trong nhóm hàm định tính chất của chuỗi)
- Gợi ý: người biết phân tích làm con toán duyệt khoảng trống ở đuôi chuỗi trước. Sau đó duyệt đầu chuõi chỉ tới giới hạn này thôi.

today100506 · 7/5/14

[VBA] [SERIES HÀM TỰ TẠO]: CODE #2: fIsBlank (HOẠT ĐỘNG GẦN GIỐNG HÀM ISBLANK CỦA EXCEL)

Mã:

[COLOR=#008000]'if cell is xl error(#DIV/0!, #VALUE!...)
'fIsBlank will return err 13: type mismatch
'hien tai, chi giai quyet duoc nhu the nay, khong biet con cach nao hay hon khong !
[/COLOR]
Function fIsBlank(ByVal cll As Range) As Boolean
    Dim iErrNum As Integer
    
[COLOR=#0000ff]    On Error Resume Next[/COLOR]
    If cll.Value = "" Then: fIsBlank = True
    iErrNum = Err.Number
[COLOR=#0000ff]    On Error GoTo 0[/COLOR]
    
    If iErrNum = 13 Then: fIsBlank = False [COLOR=#008000]'catch error[/COLOR]

End Function

HIỆN TẠI, EM CHỈ VIẾT ĐƯỢC NHƯ THẾ NÀY,
EM THẤY NÓ SAO SAO ẤY, CHẮC CHẮN PHẢI CÓ CÁI HÀM GÌ QUẢN LÝ MẤY CÁI GIÁ TRỊ ERROR CỦA EXCEL.
MONG CÁC ANH CHỊ RA TAY CHỈ GIÁO....!

ndu96081631 · 7/5/14

today100506 đã viết:
MONG CÁC ANH CHỊ RA TAY CHỈ GIÁO....!

Chỉ giáo thì không dám nhưng lời khuyên thì vầy:
Dám cá với bạn trên GPE này chưa chắc ai có đủ bản lĩnh để viết 1 hàm giống như Microsoft đã viết, dù là hàm đơn giản nhất.
Vậy nên:
Lời khuyên 1: Hàm đang có sẵn thì cứ thế mà xài, chẳng dại gì đi đụng đầu vào tường. Bạn nên nhớ rằng hàm ISBLANK nó hoạt động được với nguyên 1 khối cell và trả về kết quả là 1 mảng chứ không đơn giản đối số chỉ là 1 cell đơn đâu nha (ví dụ: =ISBLANK(A2:A8) )
Thêm nữa: Nếu phải chọn 1 hàm do "ai đó" viết hoặc do anh Bill viết thì đương nhiên tôi (và số đông) sẽ chọn anh Bill cho nó xịn (chẳng cớ gì phải dùng hàng rẻ tiền)
Lời khuyên 2: Chúng ta nên viết hàm hoặc code gì đó mà anh Bill chưa viết (hoặc quên viết)
Bạn nói rằng:

fIsBlank (HOẠT ĐỘNG NHƯ HÀM ISBLANK CỦA EXCEL)

Là hơi QUÁ. Cá với bạn rằng hàm của bạn chẳng giống tí nào so với ISBLANK của anh Bill, thậm chí là khác xa 1 trời 1 vực (và.. trật lất)
--------------------------
(Trước đây tôi định viết 1 hàm gần giống hàm SUM mà viết hoài chả được, chán nên thôi)

ChanhTQ@ · 7/5/14

Mình xin gợi í chủ topic 1 câu:

Bạn viết thử hàm MaxIf() tương tợ như MAXIF() trong E2007 để xài trong E2003 xem sao?

Coi như là bạn tập để luyện khả năng lập trình đi vậy & chúc thành công!

ndu96081631 · 7/5/14

ChanhTQ@ đã viết:
Bạn viết thử hàm MaxIf() tương tợ như MAXIF() trong E2007 để xài trong E2003 xem sao?

Coi như là bạn tập để luyện khả năng lập trình đi vậy & chúc thành công!

Em đính chính: Excel 2007 không hề có MAXIF, thậm chí Excel 2010 cũng không
Nhưng như thế lại càng hay, vì ta khỏi bị áp lực "so sánh"

today100506 · 7/5/14

ndu96081631 đã viết:
Chỉ giáo thì không dám nhưng lời khuyên thì vầy:
Dám cá với bạn trên GPE này chưa chắc ai có đủ bản lĩnh để viết 1 hàm giống như Microsoft đã viết, dù là hàm đơn giản nhất.
Vậy nên:
Lời khuyên 1: Hàm đang có sẵn thì cứ thế mà xài, chẳng dại gì đi đụng đầu vào tường. Bạn nên nhớ rằng hàm ISBLANK nó hoạt động được với nguyên 1 khối cell và trả về kết quả là 1 mảng chứ không đơn giản đối số chỉ là 1 cell đơn đâu nha (ví dụ: =ISBLANK(A2:A8) )
Thêm nữa: Nếu phải chọn 1 hàm do "ai đó" viết hoặc do anh Bill viết thì đương nhiên tôi (và số đông) sẽ chọn anh Bill cho nó xịn (chẳng cớ gì phải dùng hàng rẻ tiền)
Lời khuyên 2: Chúng ta nên viết hàm hoặc code gì đó mà anh Bill chưa viết (hoặc quên viết)
Bạn nói rằng:

Là hơi QUÁ. Cá với bạn rằng hàm của bạn chẳng giống tí nào so với ISBLANK của anh Bill, thậm chí là khác xa 1 trời 1 vực (và.. trật lất)
--------------------------
(Trước đây tôi định viết 1 hàm gần giống hàm SUM mà viết hoài chả được, chán nên thôi)

Dạ,
Thật ra mục đích của của em là tự tạo ra bài tập cho mình làm,
Rồi sẵn đấy ôn lại kiến thức...
Các anh chị đừng quá bức xúc...
Thật sự, em mới biết cho mấy hàm à, em chỉ muốn rèn luyện, chứ em đâu phải muốn đưa code lên để ra vẻ gì với ai đâu ạ...
Mong anh chị chỉ giáo thêm !

today100506 · 7/5/14

[VBA] [SERIES HÀM TỰ TẠO]: CODE #3: fMod (HOẠT ĐỘNG GẦN GIỐNG HÀM MOD CỦA EXCEL)

Mã:

[COLOR=#008000]'tested data
'               num -divisor            divisor             Abs(divisor-num)
'mod(4,2)        (2)                     2     after loop      4-4 = 0
'mod(4,3)        (1)                     3                     3-4 =-1
'mod(4,4)        (0)                     4                     4-4 = 0
'mod(4,5)        (-1)                    5                     5-4 = 1
'mod(4.4,2)      (2.4)                   2                     4-4.4 = 0.4
'mod(4.6,2)      (2.6)                   2                     4-6.4 = 0.6
'mod(0,2)                                2                     0
'mod(2,0)        (catch error at 0)      2                     return xlError: #DIV/0!
'mod(FALSE,2)                            2                     0
'mod(text,2)     (catch error at text)   2                     return xlError: #VALUE!
'mod(xlError,2)  (catch error at xlError)2                     return xlError...

'*Note:
'Han che: Ham fMod hien tai chi co the nhan tham chieu la doi so, hoac cell.

'Algorithms:
'step 1: check input value...
'step 2: processing data...
[/COLOR]
Function fMod(ByVal num As Variant, ByVal divisor As Variant) As Variant
    Dim iTmp As Double
    Dim wsf As WorksheetFunction
    Set wsf = Application.WorksheetFunction
        
[COLOR=#008000]    'Right here, when argument not vaild.
        'code will be error [error 13: type mismatch] first
                'and return xlError as #VALUE! in Microsoft Excel and stop !
[/COLOR]
[COLOR=#008000]    'step 1: check input value is valid
[/COLOR]    If IsError(num) Then: fMod = procXlError(num): Exit Function[COLOR=#008000] 'iserror?[/COLOR]
    If IsError(divisor) Then: fMod = procXlError(num): Exit Function
    
    If wsf.IsNonText(num) And wsf.IsNonText(divisor) Then[COLOR=#008000] 'isnontext ?[/COLOR]
        Select Case num [COLOR=#008000]'exceptions case[/COLOR]
            Case 0: fMod = 0: Exit Function
            Case Else
                If divisor = 0 Then
                    fMod = CVErr(xlErrDiv0): Exit Function
                Else
                    GoTo lxulychung
                End If
        End Select
    Else
        fMod = CVErr(xlErrValue): Exit Function
    End If
        
[COLOR=#008000]'step 2: processing data...
[/COLOR][COLOR=#0000ff]lxulychung:
[/COLOR]    iTmp = divisor
    Do Until iTmp > num - divisor
        iTmp = iTmp + divisor
    Loop
    fMod = Abs(iTmp - num)

    Set wsf = Nothing
End Function

Function procXlError(ByVal cll As Variant) As Variant
    Select Case cll
        Case CVErr(xlErrName): procXlError = CVErr(xlErrName)
        Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0)
        Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue)
        Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum)
        Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef)
        Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA)
        Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull)
    End Select
End Function

Cá ngừ F1 · 7/5/14

Chủ topic có vẻ muốn lên SAO nhanh chóng.. ẹc ẹc...

VetMini · 7/5/14

Cá ngừ F1 đã viết:
Chủ topic có vẻ muốn lên SAO nhanh chóng.. ẹc ẹc...

SAO có đổi ra tiền được hôn? Mà điều kiện lên SAO như thế nào vậy?

Cá ngừ F1 · 8/5/14

VetMini đã viết:
SAO có đổi ra tiền được hôn? Mà điều kiện lên SAO như thế nào vậy?

SAO trên GPE hôn đổi được ra tiền mà thể hiện những đóng góp cho diễn đàn...
Rất xin lỗi chủ topic nếu có j mạo phạm
CHUỒN LẸ thôi ,,,,,,,

Xin cảm ơn..

SA_DQ · 8/5/14

SAO thể hiện đẵng cấp của nhân vật chiếm hữu nó;

Sao không thể mua bằng tiến

&

(ó nhiều tiền chỉ có thể mua được sao trên trời, chưa chắc mua được SAO trên GPE.COM

Còn chuyện có nhiều bài để có thể quảng cáo này nọ là chuyện # hoàn toàn.

today100506 · 8/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: Count (excel) #4 CODE

Hàm Count (excel): Đếm các ô là số.

Ví dụ:
=Count(A1) [với A1 là "a"] 'return 0
=Count(A1) [với A1 là 1] 'return 1

Dưới đây là cách hoạt động của nó được trình bày dưới dạng code:

Mã:

[COLOR=#008000]'tested data
'                   value                   result
'count(1)           1                           1
'count("a")         "a"                         0
'count(1/0)         #div/0!                     0
'count(a1)          1                           1
'count(a1)          "a"                         0
'count(a1)          #div/0!                     0
'count(a1:a5)       {1,2,"a", false,#div/0!}    2

'*Note:
'Han che: Ham fCount hien tai chi co the nhan tham chieu la MOT doi so hoac range

'Algorithms:
'step 1: check input type and value...
'step 2: processing data...
[/COLOR]
Function fCount(ByVal value As Variant) As Long
    Dim iTmp As Long
    Dim wsf As WorksheetFunction
    Set wsf = Application.WorksheetFunction

[COLOR=#008000]    'check input type & value...
[/COLOR]    Select Case VarType(value)
        Case 8204 [COLOR=#008000]'isrange[/COLOR]
            For Each cll In value.Cells
                If wsf.IsNumber(cll.value) Then: iTmp = iTmp + 1
            Next cll
        Case 8192 [COLOR=#008000]'isarray[/COLOR]
            For i = 0 To UBound(value)
                If wsf.IsNumber(value(i)) Then: iTmp = iTmp + 1
            Next i
        Case Else [COLOR=#008000]'isvariable...[/COLOR]
            If wsf.IsNumber(value) Then: iTmp = iTmp + 1
    End Select
    
    fCount = iTmp
    Set wsf = Nothing
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

today100506 · 8/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsNumber (excel) #5 CODE

Hàm IsNumber (excel): Kiểm tra giá trị đưa vào có phải là số hay không ?

=IsNumber(1) 'return TRUE
=IsNumber("a") 'return FALSE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là số, giá trị nào không phải là số !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Trở lại lý thuyết toán học, ta có định nghĩa về số như sau:

Khi một giá trị có thể tính toán, thì đó là một [số]

Giờ, ta sẽ phát biểu lý thuyết toán học này dưới dạng code như sau:

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'isnumber(1)           1                           true
'isnumber("a")         "a"                          false
'isnumber(1/0)         #div/0!                      false
'isnumber(a1)          1                           true
'isnumber(a1)          "a"                          false
'isnumber(a1)          #div/0!                      false
'isnumber(empty)       empty cell                   false
'isnumber(true)        true (logic)                 false
'isnumber(false)       false (logic)                false
'isnumber(a12:a13)     {1,2}                        false

'Note:
'Han che: Hien tai fIsNumber chi nhan gia tri la doi so, hoac Cell.

'Algorithms
'test to get Err.Number
'...continue to examine the exceptions
[/COLOR]
Function fIsNumber(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
        value = value * 1
        iErrNum = Err.Number
    On Error GoTo 0
    
    If [COLOR=#0000ff]iErrNum[/COLOR] = 0 Then
        If value <> Empty And value <> True And value <> False Then: fIsNumber = True [COLOR=#008000]'exceptions[/COLOR]
    End If
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Trong code trên: Ta đã áp dụng lý thuyết toán học vào trong code, nhưng còn có một số vấn đề phát sinh:
+ Khi giá trị đưa vào là một ô rỗng (empty): excel nó sẽ hiểu là rỗng và tự gán giá trị 0
+ Khi giá trị đưa vào là một giá trị logic (TRUE/ FALSE): excel sẽ biến những giá trị này thành 1/0

--> Cho nên, để code hoạt động đúng như mong đợi, ta sẽ ta đã loại trường ra các trường hợp đặc biệt trên.

Mã:

        If value <> Empty And value <> True And value <> False Then: fIsNumber = True [COLOR=#008000]'exceptions[/COLOR]

*MỘT VÀI CÁCH VIẾT CODE KHÁC
Ta có thể viết lại hàm IsNumber (excel) bằng các hàm sẵn có của vba như sau:

Mã:

Function hamIsNumber(ByVal vnt As Variant) As Boolean
    If [COLOR=#0000ff]VarType[/COLOR](vnt) = 5 Then: hamIsNumber = True
End Function

Hàm VarType() này do anh sealand chỉ dẫn cho mình, xin cảm ơn !

today100506 · 8/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsText (excel) #6 CODE

Hàm IsText (excel): Kiểm tra giá trị đưa vào có phải là text hay không ?

=IsText(1) 'return FALSE
=IsText("a") 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là text, giá trị nào không phải là text !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Trở lại lý thuyết toán học, ta đã biết:

Một [số] là một giá trị có thể tính toán

Giờ, từ lý thuyết toán học này, ta thấy rằng:

Số thì có thể tính toán được, vậy những giá trị không tính toán được thì đó là Text (nói chung)

Nhưng cái text ta lấy ra được nó còn rất nhiều hỗn tạp, ví dụ:
+ Ô rỗng
+ Giá trị Logic (TRUE/FALSE)
+ Giá trị lỗi (#DIV/0!, #VALUE!...)

Những giá trị này đâu thể cho là text, cho nên khi đã loại trừ [số] ra rồi, ta loại trừ tiếp, những trường hợp ngoại lệ....
Từ đó, ta đã có thể xác định được giá trị đưa vào có phải là một text hay không !

Giờ ta sẽ trình bày phát biểu trên dưới dạng code như sau:

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'istext(1)           1                            false
'istext("a")         "a"                         true
'istext(1/0)         #div/0!                      false
'istext(a1)          1                            false
'istext(a1)          "a"                         true
'istext(a1)          #div/0!                      false
'istext(empty)       empty cell                   false
'istext(true)        true (logic)                 false
'istext(false)       false (logic)                false
'istext(a12:a13)     {a,b}                        false

'Note:
'Han che: Hien tai fIsText chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'test value to get Err.Number
'...continue to examine the exceptions

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'6. ...
[/COLOR]
Function fIsText(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
        value = value * 1
        iErrNum = Err.Number
    On Error GoTo 0
    
    If [COLOR=#0000ff]iErrNum[/COLOR] <> 0 _
            And Not IsError(value) _
            And VarType(value) <> 8204 _
            Then: fIsText = True
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

*MỘT VÀI CÁCH VIẾT CODE KHÁC
Ta có thể viết lại hàm IsText (excel) bằng các hàm sẵn có của vba như sau:

Mã:

Function hamIsText(ByVal value As Variant) As Boolean     
If [COLOR=#0000ff]VarType[/COLOR](value) = 8 Then: hamIsText = True 
End Function

Hàm VarType() này do anh sealand chỉ dẫn cho mình, xin cảm ơn !

sealand · 9/5/14

Người ta càng trưởng thành càng tích luỹ được nhiều từ thiên hạ, trong khi bạn lại trở về tập bò. Đã vậy, lại còn dính chưởng nữa chứ. Vis dụ:

Mã:

...............................
Function fIsText(ByVal [B][COLOR=#ff0000]value As Variant[/COLOR][/B]) As Boolean
        
    Select Case checkType(value)
        Case 1: [COLOR=#008000]'isrange[/COLOR]
            If [B][COLOR=#ff0000]value.Cells.Count[/COLOR][/B] > 1 Then: fIsText = False: Exit Function
            GoTo lxulychung
        Case 2: [COLOR=#006400]'isvariable[/COLOR]
            GoTo lxulychung
        Case 3: [COLOR=#008000]'isarray[/COLOR]
        Case Else: 'new error code #
    End Select
...............................

Bạn tính sao cái đoạn màu đỏ.

Nếu là mình thì chắc mình dùng như sau cũng ổn việc kiểm tra Text

Mã:

Function TestText(ByVal MyVar As Variant) As Boolean
TestText = VarType(MyVar) = 8
End Function

Nói chung, mình ủng hộ các bạn thôi nhưng viết Code kiểu ly khai kiến thức thiên hạ thế này thì từ Cần Thơ ra Hải Phòng chắc phải vòng sang tận chân tượng thần Tự Do mất.

VetMini · 9/5/14

sealand đã viết:
...
Bạn tính sao cái đoạn màu đỏ.
...
.

Từ đầu trang 1 đến bây giờ là trang 5. Bạn có thấy chủ thớt quan tâm về code ở bài nào chưa?
Tất cả những lời đối đáp chỉ dùng để biện hộ cho tiêu đề và mục đích. Và cái mục đích là phun code - chấm hết.

today100506 · 9/5/14

sealand đã viết:
Người ta càng trưởng thành càng tích luỹ được nhiều từ thiên hạ, trong khi bạn lại trở về tập bò. Đã vậy, lại còn dính chưởng nữa chứ. Vis dụ:

Mã:

............................... Function fIsText(ByVal [B][COLOR=#ff0000]value As Variant[/COLOR][/B]) As Boolean Select Case checkType(value) Case 1: [COLOR=#008000]'isrange[/COLOR] If [B][COLOR=#ff0000]value.Cells.Count[/COLOR][/B] > 1 Then: fIsText = False: Exit Function GoTo lxulychung Case 2: [COLOR=#006400]'isvariable[/COLOR] GoTo lxulychung Case 3: [COLOR=#008000]'isarray[/COLOR] Case Else: 'new error code # End Select ...............................

Bạn tính sao cái đoạn màu đỏ.

Nếu là mình thì chắc mình dùng như sau cũng ổn việc kiểm tra Text

Mã:

Function TestText(ByVal MyVar As Variant) As Boolean TestText = VarType(MyVar) = 8 End Function

Nói chung, mình ủng hộ các bạn thôi nhưng viết Code kiểu ly khai kiến thức thiên hạ thế này thì từ Cần Thơ ra Hải Phòng chắc phải vòng sang tận chân tượng thần Tự Do mất.

Đây là những phản hồi mình luôn rất cần....Cảm ơn sealand.
Giờ em đã biết thêm hàm VarType, và em sẽ fix lại...ngay! Thân ái

ndu96081631 · 9/5/14

VetMini đã viết:
Từ đầu trang 1 đến bây giờ là trang 5. Bạn có thấy chủ thớt quan tâm về code ở bài nào chưa?
Tất cả những lời đối đáp chỉ dùng để biện hộ cho tiêu đề và mục đích. Và cái mục đích là phun code - chấm hết.

Đến giờ thì mình cũng hết lời rồi. Chê thì sợ tác giả buồn, còn khen thì... chỉ có thể khen rằng BẠN RẤT DŨNG CẢM
Ẹc... Ẹc...

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsNonText (excel) #7 CODE

Hàm IsNonText (excel): Kiểm tra giá trị đưa vào có phải là non-text hay không ?

Cụ thể, non-text ở đây là:
1. Số
2. Ô rỗng (empty)
3. Giá trị logic (TRUE/ FALSE)
4. Giá trị lỗi (#DIV/0!, #VALUE!,...)

Ví dụ:
=IsNonText(1) 'return TRUE
=IsNonText("a") 'return FALSE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là non-text, giá trị nào không phải là non-text !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Hàm IsNonText chỉ đơn giản là ngược lại với hàm IsText mà thôi.

Để hiểu rõ vấn đề này, vui lòng xem lại bài #6 code
http://www.giaiphapexcel.com/forum/showthread.php?92078-B%C3%A0i-t%E1%BA%ADp-v%E1%BB%81-code-VBA&p=577258#post577258

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'isnontext(1)           1                           true
'isnontext("a")         "a"                          false
'isnontext(1/0)         #div/0!                     true
'isnontext(a1)          1                           true
'isnontext(a1)          "a"                          false
'isnontext(a1)          #div/0!                     true
'isnontext(empty)       empty cell                  true
'isnontext(true)        true (logic)                true
'isnontext(false)       false (logic)               true
'isnontext(a12:a13)     {a,b}                       true

'Note:
'Han che: Hien tai fIsNonText chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'test value to get Err.Number
'...continue to examine the exceptions

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'6. ...
[/COLOR]
Function fIsNonText(ByVal value As Variant) As Boolean
    If Not fIsText(value) Then: fIsNonText = [COLOR=#0000ff]True[/COLOR]
End Function

Function fIsText(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
        value = value * 1
        iErrNum = Err.Number
    On Error GoTo 0
    
    If iErrNum <> 0 _
            And Not IsError(value) _
            And VarType(value) <> 8204 _
            Then: fIsText = True
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsBlank (excel) #8 CODE

Hàm IsBlank (excel): Kiểm tra giá trị đưa vào có phải là 'blank' hay không ?

Cụ thể, blank ở đây là trống rỗng, không có giá trị gì hết !

Ví dụ:
=IsBlank(1) 'return FALSE
=IsBlank(A1) [với A1 là blank] 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là blank, giá trị nào không phải là non-blank !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Bởi vì nó đã được 'học' trước, thế nào là blank, thế nào là non-blank.
Giờ mình sẽ mô phỏng lại cách nó nhận biết một giá trị dưới dạng code:

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'isblank(1)           1                           false
'isblank("a")         "a"                         false
'isblank(1/0)         #div/0!                     false
'isblank(a1)          1                           false
'isblank(a1)          "a"                         false
'isblank(a1)          #div/0!                     false
'isblank(empty)       empty cell                 true
'isblank(true)        true (logic)                false
'isblank(false)       false (logic)               false
'isblank(a12:a13)     {a,b}                       false

'Note:
'Han che: Hien tai fIsBlank chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'test and check...
'...continue to examine the exceptions
[/COLOR]
Function fIsBlank(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
    [COLOR=#0000ff]If value [/COLOR][COLOR=#ff0000]= ""[/COLOR] Then: fIsBlank = True
    iErrNum = Err.Number
    On Error GoTo 0
    
    If iErrNum <> 0 Then: fIsBlank = False [COLOR=#008000]'is error[/COLOR]

End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Khi làm theo code trên, các bạn chú ý một số điểm sau:
Trong code trên, chúng ta đã mượn On Error Resume Next để bắt lỗi code...

Mã:

[COLOR=#0000ff]If value [/COLOR][COLOR=#ff0000]= ""[/COLOR]

+TH1 if có thể so sánh giá trị value với "", trường hợp này ko có vấn đề gì xảy ra...
+TH1 if không thể lấy giá trị của value để so sánh (lúc này value có thể là một giá trị lỗi, một range...) sẽ nảy sinh ra lỗi.
--> Khi xảy ra lỗi, nó sẽ bỏ qua câu lệnh hiện tại, và tiếp tục với các câu lệnh tiếp sau nó...

Khi viết code trên, mình thấy dùng cách đó vẫn có cái gì đó không hay,

Anh chị nào có cách nào hay hơn, vui lòng chỉ em. Thanks ! (cách varType(value)=0 thì em biết rồi).

Hoàng Trọng Nghĩa · 9/5/14

today100506 đã viết:
[VBA] [SERIES MÔ PHỎNG HÀM]: IsBlank (excel) #8 CODE

Hàm IsBlank (excel): Kiểm tra giá trị đưa vào có phải là 'blank' hay không ?

Cụ thể, blank ở đây là trống rỗng, không có giá trị gì hết !

Ví dụ:
=IsBlank(1) 'return FALSE
=IsBlank(A1) [với A1 là blank] 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là blank, giá trị nào không phải là non-blank !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Bởi vì nó đã được 'học' trước, thế nào là blank, thế nào là non-blank.
Giờ mình sẽ mô phỏng lại cách nó nhận biết một giá trị dưới dạng code:

Mã:

Function fIsBlank(ByVal value As Variant) As Boolean Dim iErrNum As Integer On Error Resume Next [COLOR=#0000ff]If value [/COLOR][COLOR=#ff0000]= ""[/COLOR] Then: fIsBlank = True iErrNum = Err.Number On Error GoTo 0 If iErrNum <> 0 Then: fIsBlank = False [COLOR=#008000]'is error[/COLOR] End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Khi làm theo code trên, các bạn chú ý một số điểm sau:
Trong code trên, chúng ta đã mượn On Error Resume Next để bắt lỗi code...

Mã:

[COLOR=#0000ff]If value [/COLOR][COLOR=#ff0000]= ""[/COLOR]

+TH1 if có thể so sánh giá trị value với "", trường hợp này ko có vấn đề gì xảy ra...
+TH1 if không thể lấy giá trị của value để so sánh (lúc này value có thể là một giá trị lỗi, một range...) sẽ nảy sinh ra lỗi.
--> Khi xảy ra lỗi, nó sẽ bỏ qua câu lệnh hiện tại, và tiếp tục với các câu lệnh tiếp sau nó...

Khi viết code trên, mình thấy dùng cách đó vẫn có cái gì đó không hay,

Anh chị nào có cách nào hay hơn, vui lòng chỉ em. Thanks ! (cách varType(value)=0 thì em biết rồi).

Nếu bạn thực hiện trên sheet thì đã có hàm ISBLANK rồi, nhưng nếu bạn mô phỏng theo hàm đó thì tôi cũng đưa cho bạn một phương pháp.

Lẽ ra, nếu không thực hiện trên Range thì chỉ cần kiểm tra nó có rỗng hay không là được, nhưng nếu hàm thực hiện trên Range thì ta bắt buộc phải cho biến của nó phải là biến Range, đồng thời phải kiểm tra xem nó có lỗi hoặc có công thức hay không, nếu nó có những giá trị đó, tất nhiên nó không phải là rỗng.

Mã:

Function IsBlanked(ByVal Value As Range) As Boolean
    If IsError(Value) Or Value.HasFormula Then
        IsBlanked = False
    Else
        IsBlanked = Value = vbNullString
    End If
End Function

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsEven (excel) #9 CODE

Hàm IsEven (excel): Kiểm tra giá trị đưa vào có phải là số chẵn hay không ?

Ví dụ:
=IsEven(1) 'return FALSE
=IsEven(2) 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là số chẵn, giá trị nào không phải là số chẵn !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Bởi vì nó đã được 'học' trước, thế nào là số chẵn, thế nào không phải là số chẵn đã được chứng minh trong phát biểu toán học sau:

Số nào có thể chia hết cho 2 là số chẵn

Để kiểm tra một giá trị là chẳn hay lẻ thì rất đơn giản, nhưng để nó trả về giá trị giống như IsEven của Excel thì hơi phức tạp một chút.
Giờ mình sẽ mô phỏng lại cách nó nhận biết một giá trị dưới dạng code như sau:

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'iseven(1)           1                            false
'iseven(2)           2                           true
'iseven("a")         "a"                          value
'iseven("b")         "b"                          value
'iseven(a1)          3                            false
'iseven(a1)          4                           true
'iseven(a1)          "a"                          value
'iseven(a1)          " "                          value
'iseven(a1)          empty cell                  TRUE
'iseven(a1)          true/ false                  value
'iseven(a1)          #div/0!                      div/0
'iseven(a12:a13)     {1,2}                        value

'Note:
'Han che: Hien tai fIsEven chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'step 1: check input value...
'         ...continue to examine the exceptions
'step 2: processing data...

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'   ...
[/COLOR]Function fIsEven(ByVal value As Variant) As Variant
    If IsError(value) Then: fIsEven = procXlError(value): Exit Function [COLOR=#008000]'error[/COLOR]
    If Not fIsNumber(value) Then [COLOR=#008000]'non-number[/COLOR]
        Select Case value
            Case "": fIsEven = True [COLOR=#008000]'exception[/COLOR]
            Case Else: fIsEven = CVErr(xlErrValue)
        End Select
    Else [COLOR=#008000]'isnumber[/COLOR]
        Select Case value Mod 2
            Case 0: fIsEven = True
            Case Else: fIsEven = False
        End Select
    End If
End Function

Function fIsNumber(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
        value = value * 1
        iErrNum = Err.Number
    On Error GoTo 0
    
    If iErrNum = 0 Then
        If value <> Empty And value <> True And value <> False Then: fIsNumber = True 'exceptions
    End If
End Function

Function procXlError(ByVal value As Variant) As Variant
    Select Case value
        Case CVErr(xlErrName): procXlError = CVErr(xlErrName)
        Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0)
        Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue)
        Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum)
        Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef)
        Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA)
        Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull)
    End Select
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Hoàng Trọng Nghĩa · 9/5/14

today100506 đã viết:
[VBA] [SERIES MÔ PHỎNG HÀM]: IsEven (excel) #9 CODE

Hàm IsEven (excel): Kiểm tra giá trị đưa vào có phải là số chẵn hay không ?

Ví dụ:
=IsEven(1) 'return FALSE
=IsEven(2) 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là số chẵn, giá trị nào không phải là số chẵn !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Bởi vì nó đã được 'học' trước, thế nào là số chẵn, thế nào không phải là số chẵn đã được chứng minh trong phát biểu toán học sau:

Để kiểm tra một giá trị là chẳn hay lẻ thì rất đơn giản, nhưng để nó trả về giá trị giống như IsEven của Excel thì hơi phức tạp một chút.
Giờ mình sẽ mô phỏng lại cách nó nhận biết một giá trị dưới dạng code như sau:

Mã:

[COLOR=#008000]'tested data ' value result 'iseven(1) 1 false 'iseven(2) 2 true 'iseven("a") "a" value 'iseven("b") "b" value 'iseven(a1) 3 false 'iseven(a1) 4 true 'iseven(a1) "a" value 'iseven(a1) " " value 'iseven(a1) empty cell TRUE 'iseven(a1) true/ false value 'iseven(a1) #div/0! div/0 'iseven(a12:a13) {1,2} value 'Note: 'Han che: Hien tai fIsEven chi nhan gia tri la doi so, Cell, Range. 'Algorithms 'step 1: check input value... ' ...continue to examine the exceptions 'step 2: processing data... '1. Number '2. text '3. empty '4. true/ false '5. xlError ' ... [/COLOR]Function fIsEven(ByVal value As Variant) As Variant If IsError(value) Then: fIsEven = procXlError(value): Exit Function [COLOR=#008000]'error[/COLOR] If Not fIsNumber(value) Then [COLOR=#008000]'non-number[/COLOR] Select Case value Case "": fIsEven = True [COLOR=#008000]'exception[/COLOR] Case Else: fIsEven = CVErr(xlErrValue) End Select Else [COLOR=#008000]'isnumber[/COLOR] Select Case value Mod 2 Case 0: fIsEven = True Case Else: fIsEven = False End Select End If End Function Function fIsNumber(ByVal value As Variant) As Boolean Dim iErrNum As Integer On Error Resume Next value = value * 1 iErrNum = Err.Number On Error GoTo 0 If iErrNum = 0 Then If value <> Empty And value <> True And value <> False Then: fIsNumber = True 'exceptions End If End Function Function procXlError(ByVal value As Variant) As Variant Select Case value Case CVErr(xlErrName): procXlError = CVErr(xlErrName) Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0) Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue) Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum) Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef) Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA) Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull) End Select End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Tức cười quá, tôi nghĩ bạn nên nghiên cứu thật kỹ rồi hãy đưa lên đây, tôi nhìn hàm bạn làm mà không nhịn cười được! Làm ơn đi!

Mã:

Function fIsEvent(ByVal Value As Range)
    If IsError(Value) Then
        fIsEvent = CVErr(Value)
    Else
        fIsEvent = (Fix(Value) Mod 2) = 0
    End If
End Function

À, cũng nói thêm, cái hàm mà bạn kiểm tra có phải là SỐ hay không (fIsNumber) thì trong VBA đã có hàm này rồi nha bạn: IsNumeric Function

Mở Help để xem cách mà hàm này hoạt động!

Ba Tê · 9/5/14

Hoàng Trọng Nghĩa đã viết:
Tức cười quá, tôi nghĩ bạn nên nghiên cứu thật kỹ rồi hãy đưa lên đây, tôi nhìn hàm bạn làm mà không nhịn cười được! Làm ơn đi!

Mã:

Function fIsEvent(ByVal Value As Range) If IsError(Value) Then fIsEvent = CVErr(Value) Else fIsEvent = (Fix(Value) Mod 2) = 0 End If End Function

À, cũng nói thêm, cái hàm mà bạn kiểm tra có phải là SỐ hay không (fIsNumber) thì trong VBA đã có hàm này rồi nha bạn: IsNumeric Function

Mở Help để xem cách mà hàm này hoạt động!

Công nhận "Ếch xanh" còn dũng cảm hơn người rất dũng cảm.
Cố lên, biết đâu được đổi màu thành "Ếch 3 màu".
Hi Hi. "Dzọt"............

ndu96081631 đã viết:
Đến giờ thì mình cũng hết lời rồi. Chê thì sợ tác giả buồn, còn khen thì... chỉ có thể khen rằng BẠN RẤT DŨNG CẢM
Ẹc... Ẹc...

today100506 · 9/5/14

Thanks anh Hoàng Trọng Nghĩa,
những phản hồi, chỉ dạy, luôn là những thứ em mong chờ...
mỗi lần post bài, là mỗi lần em bị chửi,
mỗi lần bị chửi, em lại biết thêm vài điều mới...
giờ, em lại học được một hàm mới nữa: IsNumeric .... thật là vui !

Cảm ơn các anh chị !

Hoàng Trọng Nghĩa · 9/5/14

Ba Tê đã viết:
Công nhận "Ếch xanh" còn dũng cảm hơn người rất dũng cảm.
Cố lên, biết đâu được đổi màu thành "Ếch 3 màu".
Hi Hi. "Dzọt"............

Trời ơi, lên 5 sao hồi nào dzị ta? Cũng nên lên 4 Tê luôn đi cho rồi!

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsOdd (excel) #10 CODE

Hàm IsOdd (excel): Kiểm tra giá trị đưa vào có phải là số lẻ hay không ?

Ví dụ:
=IsOdd(1) 'return TRUE
=IsOdd(2) 'return FALSE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là số lẻ, giá trị nào không phải là số lẻ !
Nhưng làm thế này mà nó có thể biết được nhỉ !

Bởi vì nó đã được 'học' trước, thế nào là số lẻ, thế nào không phải là số lẻ đã được chứng minh trong phát biểu toán học sau:

Số nào không chia hết cho 2 là số lẻ

Để kiểm tra một giá trị là chẳn hay lẻ thì rất đơn giản, nhưng để nó trả về giá trị giống như IsOdd của Excel thì hơi phức tạp một chút.

...
Thoạt nghĩ, ta có thể nghĩ đơn giản như sau, nếu số nào không phải là số chẵn thì là số lẻ thôi.
Uhm, thì thực tế là vậy, nhưng trong Excel, nó không chỉ trả về giá trị là số chẳn hay số số mà còn trả về các giá trị khác như: giá trị lỗi (#DIV/0!, ...), giá trị Logic, giá trị không hợp lệ #VALUE!...

Vậy thì thay vì ta dựa vào cái hàm IsEven để tìm ra số lẻ, rồi lại phải xét trường hợp này, trường hợp nọ, thì giờ ta viết hẳn một hàm tách biệt còn hiệu quả hơn. Giờ mình sẽ mô phỏng lại cách nó nhận biết một giá trị dưới dạng code như sau:

Mã:

[COLOR=#008000]'tested data
'                   value                       result
'isodd(1)           1                           true
'isodd(2)           2                            false
'isodd("a")         "a"                          value
'isodd("b")         "b"                          value
'isodd(a1)          3                           true
'isodd(a1)          4                            false
'isodd(a1)          "a"                          value
'isodd(a1)          " "                          value
'isodd(a1)          empty cell                   false
'isodd(a1)          true/ false                  value
'isodd(a1)          #div/0!                      div/0
'isodd(a12:a13)     {1,2}                        value

'Note:
'Han che: Hien tai fIsOdd chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'step 1: check input value...
'         ...continue to examine the exceptions
'step 2: processing data...

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'   ...
[/COLOR]Function fIsOdd(ByVal value As Variant) As Variant
    If IsError(value) Then: fIsOdd = procXlError(value): Exit Function [COLOR=#008000]'error[/COLOR]
    If Not IsNumeric(value) Then [COLOR=#008000]'non-number[/COLOR]
        Select Case value
            Case "": fIsOdd = False [COLOR=#008000]'exception[/COLOR]
            Case Else: fIsOdd = CVErr(xlErrValue)
        End Select
    Else [COLOR=#008000]'isnumber[/COLOR]
        Select Case [COLOR=#0000ff]value Mod 2[/COLOR]
            Case Is [COLOR=#0000ff]<> 0[/COLOR]: fIsOdd = True
            Case Else: fIsOdd = False
        End Select
    End If
End Function

Function procXlError(ByVal value As Variant) As Variant
    Select Case value
        Case CVErr(xlErrName): procXlError = CVErr(xlErrName)
        Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0)
        Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue)
        Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum)
        Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef)
        Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA)
        Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull)
    End Select
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

Lưu ý: Code trên áp dụng theo chỉ dẫn của anh Hoàng Trọng Nghĩa, em đã thay hàm tự tạo fIsNumber = Isnumeric của VBA.
Cảm ơn anh đã chỉ dạy cho em biết thêm một hàm mới.

Hoàng Trọng Nghĩa · 9/5/14

today100506 đã viết:
Lưu ý anh Hoàng Trọng Nghĩa: Code trên em sử dụng những hàm mình tự mô phỏng để làm quen với code, nên hiện tại, không sử dụng hàm Isnumeric của vba. Thân !

Theo tôi thì, sau khi đã được ai đó hướng dẫn, thì bạn phải khắc phục, cũng tương tự như hàm ISEVENT thì hàm này ngược lại, vậy cho nên bạn phải theo hướng mới mà áp dụng chứ? Hay bạn cứ vẫn thích "phô trương" phương thức của bạn?

Chỉ là góp ý, còn tùy bạn muốn nghĩ tôi sao cũng được.

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: IsLogical (excel) #11 CODE

Hàm IsLogical (excel): Kiểm tra giá trị đưa vào có phải là giá trị LOGIC hay không ?

Ví dụ:
=IsLogical(1) 'return FALSE
=IsLogical(FALSE) 'return TRUE

Oh, hay quá ! Nó thật là thông minh, nó có thể biết được giá trị nào là giá trị logic, giá trị nào không phải là giá trị logic!
Nhưng làm thế này mà nó có thể biết được nhỉ !

Cũng đơn giản thôi, nếu giá trị trong ô đó là TRUE/ FALSE thì đó là giá trị logic.
Nghe thật là đơn giản, và code cũng đơn giản không kém !
Giờ mình sẽ phát biểu cách hoạt động của hàm trên dưới dạng code:

Mã:

[COLOR=#008000]'tested data
'                   value                           result
'islogical(1)           1                            false
'islogical("a")         "a"                          false
'islogical(a1)          1                            false
'islogical(a1)          "a"                          false
'islogical(a1)          " "                          false
'islogical(a1)          empty cell                   false
'islogical(a1)          true/ false                 true
'islogical(a1)          #div/0!                      false
'islogical(a12:a13)     {1,2}                        false

'Note:
'Han che: Hien tai fIsLogical chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'step 1: test and check...
'         ...continue to examine the exceptions
'step 2: processing data...

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'   ...
[/COLOR]Function fIsLogical(ByVal value As Variant) As Boolean
    Dim iErrNum As Integer
    
    On Error Resume Next
    If value = True Or value = False And value <> "" Then: fIsLogical = True[COLOR=#008000] '<>"" , exception case[/COLOR]
    iErrNum = Err.Number
    On Error GoTo 0
    
    If iErrNum <> 0 Then: fIsLogical = False
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

*MỘT VÀI CÁCH VIẾT CODE KHÁC:

Mã:

Function fIsLogical(ByVal value As Variant) As Boolean
    If [COLOR=#0000ff]VarType(value)[/COLOR] = vbBoolean Then: fIsLogical = True
End Function

Cách này, anh sealand hướng dẫn cho mình.

today100506 · 9/5/14

[VBA] [SERIES MÔ PHỎNG HÀM]: Abs (excel) #12 CODE

Hàm Abs (excel): Trả về giá trị tuyệt đối của số.

Ví dụ:
=Abs(1) 'return 1
=Abs(-1) 'return 1

Dưới đây là cách thức hoạt động của hàm đượ phát biểu dưới dạng code:

Mã:

[COLOR=#008000]'tested data
'                value                       result
'abs(1)           1                           1
'abs("a")         "a"                          value
'abs(1/0)         #div/0!                      div0
'abs(a1)          -1                          1
'abs(a1)          "a"                          value
'abs(a1)          #div/0!                      div0
'abs(empty)       empty cell                  0
'abs(true)        true (logic)                1
'abs(false)       false (logic)               0
'abs(a12:a13)     {a,b}                        value

'Note:
'Han che: Hien tai fAbs chi nhan gia tri la doi so, Cell, Range.

'Algorithms
'step 1:check input type & value...
'...continue to examine the exceptions
'step 2: processing data...

'1. Number
'2. text
'3. empty
'4. true/ false
'5. xlError
'  ...
[/COLOR]Function fAbs(ByVal num As Variant) As Variant
    Select Case VarType(num)
        Case 8204: fAbs = CVErr(xlErrValue) [COLOR=#008000]'range[/COLOR]
        Case 8192: [COLOR=#008000]'array[/COLOR]
        Case 10: fAbs = procXlError(num) [COLOR=#008000]'xlError[/COLOR]
        Case 11 [COLOR=#008000]'logical[/COLOR]
            Select Case num
                Case True: fAbs = 1
                Case False: fAbs = 0
            End Select
        Case Else
            If IsNumeric(num) Then
                Select Case num [COLOR=#008000]'number[/COLOR]
                    Case Is >= 0: fAbs = num
                    Case Is < 0: fAbs = -num
                End Select
            Else
                fAbs = CVErr(xlErrValue) [COLOR=#008000]'non-number[/COLOR]
            End If
    End Select
End Function

Function procXlError(ByVal value As Variant) As Variant
    Select Case value
        Case CVErr(xlErrName): procXlError = CVErr(xlErrName)
        Case CVErr(xlErrDiv0): procXlError = CVErr(xlErrDiv0)
        Case CVErr(xlErrValue): procXlError = CVErr(xlErrValue)
        Case CVErr(xlErrNum): procXlError = CVErr(xlErrNum)
        Case CVErr(xlErrRef): procXlError = CVErr(xlErrRef)
        Case CVErr(xlErrNA): procXlError = CVErr(xlErrNA)
        Case CVErr(xlErrNull): procXlError = CVErr(xlErrNull)
    End Select
End Function

(*Lưu ý: Code chỉ có giá trị mô phỏng, minh họa, không thể so sánh với code chuẩn & và không có giá trị thay thế !)
(*Trường hợp code có sai sót, chưa hay, hoặc có chỗ nào chưa hợp lý, xin vui lòng góp ý và chỉ dẫn thêm... bằng code!)

VetMini · 9/5/14

Hoàng Trọng Nghĩa đã viết:
Theo tôi thì, sau khi đã được ai đó hướng dẫn, thì bạn phải khắc phục, cũng tương tự như hàm ISEVENT thì hàm này ngược lại, vậy cho nên bạn phải theo hướng mới mà áp dụng chứ? Hay bạn cứ vẫn thích "phô trương" phương thức của bạn?

Chỉ là góp ý, còn tùy bạn muốn nghĩ tôi sao cũng được.

Qua bài số 57, chủ thớt có nói rõ là không muốn nghe lời bàn. Người nào muốn bàn thì phải chứng minh bằng code.

Điều này cho biết chủ thớt:
1. không quan tâm đến giải thuật mà chỉ quan tâm đến code; hoặc
2. cho rằng người không đưa ra code là người chỉ biết nói dóc; hoặc
3. cả hai điều trên

Thực ra, nếu chủ thớt quan tâm đến giải thuật thì đã chịu khó tìm hiểu và đã nhận ra rằng trên diễn đàn này có hơn một lần, tôi từng giải thích rằng dùng con toán MOD để xét số chẵn lẻ là cách của tay mơ. Dân sành điệu đem số ra xét bit nhỏ nhất; nếu bit này 'ON' là số lẻ, và 'OFF' lả số chẵn.

thanhlanh · 10/5/14

Topic này đặt ở chuyên mục thư giãn thì hợp lý hơn, mình tin rằng lúc này số người vào đây để đọc code, tải file thì ít còn vào để xem diễn biến của topic và thư giãn thì nhiều.

Hoàng Trọng Nghĩa · 10/5/14

VetMini đã viết:
Thực ra, nếu chủ thớt quan tâm đến giải thuật thì đã chịu khó tìm hiểu và đã nhận ra rằng trên diễn đàn này có hơn một lần, tôi từng giải thích rằng dùng con toán MOD để xét số chẵn lẻ là cách của tay mơ. Dân sành điệu đem số ra xét bit nhỏ nhất; nếu bit này 'ON' là số lẻ, và 'OFF' lả số chẵn.

Theo hàm ISEVEN của hàm Excel thì cách thức nó hoạt động là lấy số nguyên để tính, giả sử giá trị là 2.9999 thì nó vẫn tính là số chẳn. Cho nên ta chỉ cần chọn trong giá trị để lấy số nguyên là được (thay vì dùng hàm INT thì dùng hàm FIX nó chắc ăn hơn), sau đó dùng MOD để kiểm tra lại là được, cho nên không cần phải xét bit, theo em nghĩ như thế.

ndu96081631 · 10/5/14

thanhlanh đã viết:
Topic này đặt ở chuyên mục thư giãn thì hợp lý hơn, mình tin rằng lúc này số người vào đây để đọc code, tải file thì ít còn vào để xem diễn biến của topic và thư giãn thì nhiều.

Làm thêm chừng vài chục bài nữa chắc cũng phải vậy quá
Cười nhiều chút cho đời bớt khổ ###@#!

Ba Tê · 10/5/14

ndu96081631 đã viết:
Làm thêm chừng vài chục bài nữa chắc cũng phải vậy quá

Cười nhiều chút cho đời bớt khổ

Việc hôm nay chớ để ngày mai.
+-+-+-+

VetMini · 10/5/14

Hoàng Trọng Nghĩa đã viết:
Theo hàm ISEVEN của hàm Excel thì cách thức nó hoạt động là lấy số nguyên để tính, giả sử giá trị là 2.9999 thì nó vẫn tính là số chẳn. Cho nên ta chỉ cần chọn trong giá trị để lấy số nguyên là được (thay vì dùng hàm INT thì dùng hàm FIX nó chắc ăn hơn), sau đó dùng MOD để kiểm tra lại là được, cho nên không cần phải xét bit, theo em nghĩ như thế.

Hàm MOD được thể hiện bằng một con toán chia và một con toán trừ. Bit And là một trong những con toán căn bản của CPU - rất nhanh và rất gọn. Vì vậy, nếu ngôn ngữ hổ trợ phép tính bit and thì nó giải thuật xét bit sẽ là giải thuật hiệu nghiệm hơn hàm MOD gấp bội lần.

phân tích: số nguyên được chứa trong bộ nhớ dưới dạng nhị phân. Theo dạng nhị phân, bit nhỏ nhất tượng trưng cho số 1. Số lẻ có dạng 2n + 1 cho nên bit nhỏ nhất này luôn luôn ON, ngược lại số có dạng 2n thì bit này OFF.
Đồng thời, trong VBA phép and là phép toán bit. Có nghĩa là hai vế sẽ được AND từng bit một với nhau. Ví dụ, số 1 là 01, and với số 2 là 10 sẽ ra 0; và 1 and 3 = 1 (3 nhị phân là 11); 2and 3 = 2
Suy ra, khi ta đem 1 AND với một số có bit nhỏ nhất ON thì kết quả sẽ là 1; Trái lại, nếu số có bit nhỏ nhất OFF thì kết quả là 0.

áp dụng:
If (n And 1) Then
là số lẻ
Else
là số chẵn
End If

function IsEven_Che(byVal n As Long) As Boolean
IsEven_Che = not (1 and n)
End Function

gọn gàng nhẹ nhàng. Nếu muốn bẫy lỗi gì đó thì viết thêm 1 hàm gói bên ngoài, và bẫy lỗi trước khi gọi hàm này.

today100506 · 10/5/14

VetMini đã viết:
Hàm MOD được thể hiện bằng một con toán chia và một con toán trừ. Bit And là một trong những con toán căn bản của CPU - rất nhanh và rất gọn. Vì vậy, nếu ngôn ngữ hổ trợ phép tính bit and thì nó giải thuật xét bit sẽ là giải thuật hiệu nghiệm hơn hàm MOD gấp bội lần.

phân tích: số nguyên được chứa trong bộ nhớ dưới dạng nhị phân. Theo dạng nhị phân, bit nhỏ nhất tượng trưng cho số 1. Số lẻ có dạng 2n + 1 cho nên bit nhỏ nhất này luôn luôn ON, ngược lại số có dạng 2n thì bit này OFF.
Đồng thời, trong VBA phép and là phép toán bit. Có nghĩa là hai vế sẽ được AND từng bit một với nhau. Ví dụ, số 1 là 01, and với số 2 là 10 sẽ ra 0; và 1 and 3 = 1 (3 nhị phân là 11); 2and 3 = 2
Suy ra, khi ta đem 1 AND với một số có bit nhỏ nhất ON thì kết quả sẽ là 1; Trái lại, nếu số có bit nhỏ nhất OFF thì kết quả là 0.

áp dụng:
If (n And 1) Then
là số lẻ
And
là số chẵn
End If

function IsEven_Che(byVal n As Long) As Boolean
IsEven_Che = not (1 and n)
End Function

gọn gàng nhẹ nhàng. Nếu muốn bẫy lỗi gì đó thì viết thêm 1 hàm gói bên ngoài, và bẫy lỗi trước khi gọi hàm này.

tôi từng giải thích rằng dùng con toán MOD để xét số chẵn lẻ là cách của tay mơ...

Đây là điều em muốn nghe...
Giờ em lại học được thêm một điều mới...
Xin cảm ơn VetMini

VetMini · 10/5/14

today100506 đã viết:
Đây là điều em muốn nghe...
Giờ em lại học được thêm một điều mới...

Đây là điều tôi muốn chứng minh với mọi người: người nào nói chuyện không đưa ra code thì bạn cho là nói dóc.

HoangGAC · 24/2/20

thanhlanh đã viết:
Topic này đặt ở chuyên mục thư giãn thì hợp lý hơn, mình tin rằng lúc này số người vào đây để đọc code, tải file thì ít còn vào để xem diễn biến của topic và thư giãn thì nhiều.

Hợp lý này bác này

VetMini · 24/2/20

HoangGAC đã viết:
Hợp lý này bác này

Một cái bài dở bẹt, cũ đã 6 năm mà cũng ráng đào lên được.

batman1 · 24/2/20

VetMini đã viết:
Một cái bài dở bẹt, cũ đã 6 năm mà cũng ráng đào lên được.

Đào lên thì mới có cớ tham gia. Chả nhẽ hơn 3 năm không viết bài nào? Không có khó khăn gì, vd. không làm gì liên qua tới ếch xào, chả nhẽ bịa ra một vấn đề để hỏi?

VetMini · 24/2/20

batman1 đã viết:
Đào lên thì mới có cớ tham gia. Chả nhẽ hơn 3 năm không viết bài nào? Không có khó khăn gì, vd. không làm gì liên qua tới ếch xào, chả nhẽ bịa ra một vấn đề để hỏi?

Ý tôi nói là hết chỗ lại đi đào một cái thớt mà chính mình cũng cho là đăng trật góc.
Nếu đã cho là nó trật chỗ thì làm ngơ cho nó chìm luôn, bới lên chi?

(Ờ mà bác nói "có cớ tham gia" tôi mới nhận ra hình như chính cái nit cũng là hơn 3 năm đào lại)

HoangGAC · 25/2/20

VetMini đã viết:
Ý tôi nói là hết chỗ lại đi đào một cái thớt mà chính mình cũng cho là đăng trật góc.
Nếu đã cho là nó trật chỗ thì làm ngơ cho nó chìm luôn, bới lên chi?

(Ờ mà bác nói "có cớ tham gia" tôi mới nhận ra hình như chính cái nit cũng là hơn 3 năm đào lại)
View attachment 232413

E vẫn vào mà chẳng qua, k cmt rep topic thôi.

Chứ đào lại đâu. Bác nói thế buồn

Bài tập về code VBA (1 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thành viên chính thức

File đính kèm

/(hông là gì!

Thành viên chính thức

0901452không62

Thành viên gạo cội

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

Bad Excel Member

/(hông là gì!

Đang đi tìm hòn đá

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

File đính kèm

Huyền thoại GPE

Thành viên chính thức

Huyền thoại GPE

/(hông là gì!

Thành viên tích cực

Thành viên gạo cội

/(hông là gì!

Huyền thoại GPE

0901452không62

File đính kèm

Thành viên chính thức

Đang đi tìm hòn đá

Thành viên chính thức

File đính kèm

Huyền thoại GPE

0901452không62

Huyền thoại GPE

Thành viên chính thức

Thành viên chính thức

File đính kèm

( ͡° ͜ʖ ͡°)

Đang đi tìm hòn đá

( ͡° ͜ʖ ͡°)

/(hông là gì!

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên gạo cội

Đang đi tìm hòn đá

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Cạo Rồi Khỏi Gội

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Đang đi tìm hòn đá