Những câu hỏi về code, xin giải thích các code, đề nghị các bạn gửi vào đây

ST-Lu! · 23/10/08

Kể từ hôm nay, tất cả những câu hỏi nhờ giải thích dùm một đoạn code, hay là hỏi những vấn đề linh tinh gì liên quan đến cách viết code, đề nghị các bạn gửi chung vào đây.

Những đề tài mới với tiêu đề: "Nhờ giải thích dùm đoạn code", mà không nói rõ là code gì, code dùng để làm gì, sẽ bị xóa.

BQT
----------------------------------------------------------------------------------------------------------------

Em xin được hỏi 2 đoạn code sau có tương đương nhau ?

Cells(Cells.Rows.Count, 1).End(xlUp).Row có tương đương với [A65000].End(xlup).row

Cám ơn các anh chỉ giáo

matran25251325 · 11/2/13

Đoạn code trên mình nhặt của người khác nên mình bít đâu mà sửa. với file mình post lên bạn có cách nào giúp mình với.

ptm0412 · 11/2/13

File của bạn đọc cũng như không ấy. Sheet dùng để vlookup thì lại xóa đi.
Bạn muốn gì ở câu lệnh Target.Offset(0, 5) = "=(O" & n & "*D" & m & ",3)"?
Bạn đang làm mất thì giờ của chính bạn, nếu không nói rõ yêu cầu.

matran25251325 · 12/2/13

ý mình là ở cột số lượng ( cột P) sheet TLuong thì công thức tính số lượng là không đúng sau khi tra mã hiệu. Ví dụ mã hiệu AE.11313 sau khi tra thì có:
số lượng xi măng: P11 = o11xD10
Cát: P12=O12xD10
Đá dăm: P13=O13xD10
.....
Mã hiệu AE.243 sau khi tra thì có:
số lượng xi măng: P17 = o17xD10 (D16 mới đúng)
Cát: P18 = O18xD10 (D16 mới đúng)
Đá dăm: P19 = O19xD10 (D16 mới đúng)
Bạn Right-click cột A22 và chọn 1 công việc tiếp theo thì bạn thấy công thức la sai.
Còn cột Q ko ảnh hưởng gì

viehoai · 12/2/13

matran25251325 đã viết:
ý mình là ở cột số lượng ( cột P) sheet TLuong thì công thức tính số lượng là không đúng sau khi tra mã hiệu. Ví dụ mã hiệu AE.11313 sau khi tra thì có:
số lượng xi măng: P11 = o11xD10
Cát: P12=O12xD10
Đá dăm: P13=O13xD10
.....
Mã hiệu AE.243 sau khi tra thì có:
số lượng xi măng: P17 = o17xD10 (D16 mới đúng)
Cát: P18 = O18xD10 (D16 mới đúng)
Đá dăm: P19 = O19xD10 (D16 mới đúng)
Bạn Right-click cột A22 và chọn 1 công việc tiếp theo thì bạn thấy công thức la sai.
Còn cột Q ko ảnh hưởng gì

Công thức bạn sai bởi vì ngay từ sheet "MAUCHUAN" công thức ấy chưa chẩn làm sao đúng được. Bạn sửa các công thức cột P sheet "MAUCHUAN" cho đúng, chú ý không có dấu $ trong công thức, nếu không vẫn sai

ptm0412 · 12/2/13

Thêm đoạn này vào sự kiện worksheet_Change:

PHP:

            For Each Cll In Sheet1.Range("P" & Target.Row + 1).Resize(iNhay - 1, 1)
                Cll.Value = "=D" & Target.Row & "*O" & Cll.Row
            Next

Sau khi xóa code thừa, nguyên code sẽ là:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Vung As Range, iHang As Long, iNhay As Long
    Dim Cll As Range
    If Not Intersect(Target, [A4:A65536]) Is Nothing Then
        If Target.Count = 1 Then
            Set Vung = Sheets("MAUCHUAN").Range(Sheets("MAUCHUAN").[B10], _
            Sheets("MAUCHUAN").[B10000].End(xlUp)).Offset(, -1)
            iHang = Application.WorksheetFunction.Match(Target, Vung, 0)
            iNhay = Vung(iHang).End(xlDown).Row - Vung(iHang).Row
            Vung(iHang).Offset(, 1).Resize(iNhay, 17).Copy Target.Offset(, 1)
            For Each Cll In Sheet1.Range("P" & Target.Row + 1).Resize(iNhay - 1, 1)
                Cll.Value = "=D" & Target.Row & "*O" & Cll.Row
            Next
        End If
    End If
End Sub

matran25251325 · 12/2/13

viehoai đã viết:
Công thức bạn sai bởi vì ngay từ sheet "MAUCHUAN" công thức ấy chưa chẩn làm sao đúng được. Bạn sửa các công thức cột P sheet "MAUCHUAN" cho đúng, chú ý không có dấu $ trong công thức, nếu không vẫn sai

Hic sheet MAUCHUAN mấy trăm mã hiệu, nếu làm thủ công thì .......Đuối

matran25251325 · 12/2/13

ptm0412 đã viết:

Thêm đoạn này vào sự kiện worksheet_Change:

PHP:

            For Each Cll In Sheet1.Range("P" & Target.Row + 1).Resize(iNhay - 1, 1)
                Cll.Value = "=D" & Target.Row & "*O" & Cll.Row
            Next

Sau khi xóa code thừa, nguyên code sẽ là:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Vung As Range, iHang As Long, iNhay As Long
    Dim Cll As Range
    If Not Intersect(Target, [A4:A65536]) Is Nothing Then
        If Target.Count = 1 Then
            Set Vung = Sheets("MAUCHUAN").Range(Sheets("MAUCHUAN").[B10], _
            Sheets("MAUCHUAN").[B10000].End(xlUp)).Offset(, -1)
            iHang = Application.WorksheetFunction.Match(Target, Vung, 0)
            iNhay = Vung(iHang).End(xlDown).Row - Vung(iHang).Row
            Vung(iHang).Offset(, 1).Resize(iNhay, 17).Copy Target.Offset(, 1)
            For Each Cll In Sheet1.Range("P" & Target.Row + 1).Resize(iNhay - 1, 1)
                Cll.Value = "=D" & Target.Row & "*O" & Cll.Row
            Next
        End If
    End If
End Sub

Code gần đúng rồi, nhưng vẫn còn 2 vướng mắc:
- Mã hiệu có máy thi công và bù nguyên liệu thì công thức ở cột P (phần tô đỏ) sẽ trống, còn phần bù nguyên liệu thì bù nguyên liệu máy nào sẽ = định mức máy đó (P21 = O16, P22=O17).
- Code có phần lỗi là các mã hiệu ở sheet MAUCHUAN (sheet nguồn) có các hàng kề nhau thì nếu tra 1 mã hiêu thì các mã hiệu đó sẽ nhảy theo, do đó ở sheet MAUCHUAN mình toàn insert 1 hàng trống.
http://www.mediafire.com/?9x5rbqw78c7igud

ptm0412 · 12/2/13

Gần đúng là thế nào, bạn hỏi cái gì tôi sửa code chỗ đó, tự nhiêu đẻ ra yêu cầu mới.
1. Máy thi công & bù nguyên liệu: Bạn cho 1 cái if vào
2. Bạn chèn dòng trống rồi thì phải đúng. Không chèn mới sai.

matran25251325 · 12/2/13

Đã giúp thì bạn giúp cho chót luôn đi, mình thử nhiều cách mà toàn lỗi chỗ Máy thi công & bù nguyên liệu, Còn chỗ dòng trống có cách nào không chèn vẫn chạy bình thường không?

ptm0412 · 12/2/13

Xem file, thì cách tốt nhất là sheet mẫu chuẩn bạn làm cho chuẩn đúng nghĩa chuẩn. Rồi copy qua là xong chuyện.

Còn vụ 1 dòng không chèn thì sửa code như sau:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Vung As Range, iHang As Long, iNhay As Long
    Dim Cll As Range
    If Not Intersect(Target, [A4:A65536]) Is Nothing Then
        If Target.Count = 1 Then
            Set Vung = Sheets("MAUCHUAN").Range(Sheets("MAUCHUAN").[B10], _
            Sheets("MAUCHUAN").[B10000].End(xlUp)).Offset(, -1)
            iHang = Application.WorksheetFunction.Match(Target, Vung, 0)
            iNhay = IIf(Vung(iHang + 1) <> "", 1, Vung(iHang).End(xlDown).Row - Vung(iHang).Row)
            Vung(iHang).Offset(, 1).Resize(iNhay, 17).Copy Target.Offset(, 1)
            If iNhay > 1 Then
                For Each Cll In Sheet1.Range("P" & Target.Row + 1).Resize(iNhay - 1, 1)
                    Cll.Value = "=D" & Target.Row & "*O" & Cll.Row
                Next
            End If
        End If
    End If
End Sub

Tuy nhiên cách tốt hơn, là việc copy này đưa luôn vào code nhấn nút chọn của form, khỏi bắt lỗi lôi thôi:

PHP:

Private Sub CommandButton2_Click()
With Selection
   .Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
   .Offset(, 1).Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
   .Offset(, 2).Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
    Dim Vung As Range, iHang As Long, iNhay As Long
    Dim Cll As Range
        Set Vung = Sheets("MAUCHUAN").Range(Sheets("MAUCHUAN").[B10], _
        Sheets("MAUCHUAN").[B10000].End(xlUp)).Offset(, -1)
        iHang = Application.WorksheetFunction.Match(.Value, Vung, 0)
        iNhay = IIf(Vung(iHang + 1) <> "", 1, Vung(iHang).End(xlDown).Row - Vung(iHang).Row)
        Vung(iHang).Offset(, 1).Resize(iNhay, 17).Copy .Offset(, 1)
        If iNhay > 1 Then
            For Each Cll In Sheet1.Range("P" & .Row + 1).Resize(iNhay - 1, 1)
                Cll.Value = "=D" & .Row & "*O" & Cll.Row
            Next
        End If
End With
End Sub

pdhuyxn2 · 13/2/13

Nhờ các Bác giải thích hộ em đoạn code trên

Option Explicit

Private Function SwapChars(chars As String) As String

Dim i As Integer
Dim r As String
For i = Len(chars) To 1 Step -1
r = r & Mid(chars, i, 1)
Next
SwapChars = r

End Function

Private Function SwapStr(str As String, GroupNum As Integer, Code As Boolean) As String

'swap each group chars in string
Dim i As Integer, txt As String: txt = str
Dim chars As String
Dim r As String
Dim k As Integer

If Code Then k = 1 Else k = -1

Do While Len(txt) >= GroupNum
chars = Mid(txt, 1, GroupNum)
r = r & SwapChars(chars)
txt = Right(txt, Len(txt) - GroupNum)
Loop

r = r & SwapChars(txt)
SwapStr = r

End Function

Private Function Coding(txt As String, Key As String) As String

Dim r As String: r = txt
Dim i As Integer, N As Integer
For i = 1 To Len(Key)
N = CInt(Mid(Key, i, 1))
r = SwapStr(r, N, True)
Next
Coding = r
End Function

Private Function DeCoding(txt As String, Key As String) As String

Dim r As String: r = txt

Dim i As Integer, N As Integer
For i = Len(Key) To 1 Step -1
N = CInt(Mid(Key, i, 1))
r = SwapStr(r, N, False)
Next
DeCoding = r
End Function
'
'Code for register
'
Private Function Code1(ByVal s As String) As String
Dim i As Integer
Dim tg As String
Dim ch As String * 1
For i = 1 To Len(s)
ch = Mid(s, i, 1)
tg = tg & Asc(ch) - i * 2
If i Mod 2 = 0 And i < Len(s) Then tg = tg & "-"
Next
Code1 = tg
End Function

Private Function Decode1(ByVal s As String) As String
On Error Resume Next
Dim i As Integer
Dim tg As String
Dim ch As String
i = 1
Do While i < Len(s)
If i Mod 5 = 0 And i < Len(s) Then i = i + 1
ch = Mid(s, i, 2)
tg = tg & Chr(CInt(ch) + (Len(tg) + 1) * 2)
i = i + 2
Loop
Decode1 = tg
End Function

Public Function CheckPLSCopyRight() As Boolean

CheckPLSCopyRight = True

Dim Sys32Dir As String: Sys32Dir = WindowsDirectory & "\system32\"

Dim RegFile As String: RegFile = "userpls.dll"

Dim m_a_c As String
m_a_c = Getm_a_cAddress()
m_a_c = Right(m_a_c, Len(m_a_c) - 2)
m_a_c = Coding(m_a_c, "94323")
'Kreg = vbNull

Dim Key As String

If Dir(Sys32Dir & RegFile) = "" Then
'
'Show Registration form
'
With FrmReg
.TxtUserID = m_a_c
.Show 1
Key = .TxtRegCode.Text
Key = Decode1(Key)
Key = DeCoding(Key, "94323")
If Key = m_a_c Then
'
'Create File
'
Open Sys32Dir & RegFile For Output As #1
Print #1, .TxtRegCode.Text
Close #1
MsgBox "Thank you for registration.", vbInformation
Else
MsgBox "Invalid RegKey!", vbCritical
End If
End With
End If
'
'Test registration
'
If Dir(Sys32Dir & RegFile) = "" Then Exit Function

Dim FDate As Date
FDate = FileDate(Sys32Dir & RegFile)
'
'Expired date = 365 = 12 month
'
If ((Now - FDate) > 365 * 5) Or (Now > CDate("30 March 2015")) Then
MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
'Kill Sys32Dir & RegFile
'Empty file
Open Sys32Dir & RegFile For Output As #1
Print #1, ""
Close #1
Exit Function
End If
'
'Open file for checking RegKey
'
Open Sys32Dir & RegFile For Input As #1
Input #1, Key
Close #1
Key = Decode1(Key)
Key = DeCoding(Key, "94323")

'If Key <> m_a_c Then
' MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
' Exit Function
'End If

MyPrompt "Check AutoCad OK"
CheckPLSCopyRight = True
End Function

Private Function FileDate(Fname As String) As Date

Dim FS As Object, F As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set F = FS.GetFile(Fname)
FileDate = F.DateCreated
Set FS = Nothing

End Function

Public Function Getcode(m_a_c As String) As String

Getcode = Coding(m_a_c, "94323")
Getcode = Code1(Getcode)

End Function

ChanhTQ@ · 14/2/13

Chúng ta sẽ lần lượt chinh fục từng Anh một nhe bạn:

(1)

PHP:

Private Function SwapChars(chars As String) As String

 Dim i As Integer
 Dim r As String
 For i = Len(chars) To 1 Step -1
    r = r & Mid(chars, i, 1)
 Next
 SwapChars = r
End Function

Hàm này có công dụng đão các ký tự trong chuỗi;
Như ta cung cấp cho nó "GPE.COM", nó sẽ trả về "MOC.EPG"

(2)

PHP:

Private Function SwapStr(str As String, GroupNum As Integer, Code As Boolean) As String
'swap each group chars in string'
1 Dim i As Integer,  k As Integer
 Dim chars As String, txt As String, r As String

3 txt = str
 If Code Then k = 1 Else k = -1

5 Do While Len(txt) >= GroupNum
    chars = Mid(txt, 1, GroupNum)
7    r = r & SwapChars(chars)
    txt = Right(txt, Len(txt) - GroupNum)
9 Loop
 r = r & SwapChars(txt)
11 SwapStr = r

End Function

Hàm thứ 2 này thực hiện 3 việc;
1: (Dòng lệnh 6) Cắt chuỗi được cung cấp cho hàm theo nhóm có độ dài theo tham biến GroupNum
2: (Dòng lệnh 7) Gọi hàm đầu để đão nhóm kí tự vừa cắt
3: (Dòng lệnh 8) Làm động tác như dòng lệnh 6, nhưng với nhóm các ký tự cuối còn lại

Tuy nhiên, theo mình thì vòng lặp này tiềm ẩn nhiều nguy cơ một khi GroupNum nhớn hơn nhiều so với độ dài chuỗi đưa cho hàm
(Chúng ta cần bẩy lỗi cho hàm)

matran25251325 · 14/2/13

Đã chuyển từ RightCLick sang DoubleClick để làm. TK mọi người.

pdhuyxn2 · 15/2/13

Nhờ các Bác Giải thích giùm em đoạn còn lại

pdhuyxn2 · 15/2/13

Option Explicit

Private Function SwapChars(chars As String) As String

Dim i As Integer
Dim r As String
For i = Len(chars) To 1 Step -1
r = r & Mid(chars, i, 1)
Next
SwapChars = r

End Function

Private Function SwapStr(str As String, GroupNum As Integer, Code As Boolean) As String

'swap each group chars in string
Dim i As Integer, txt As String: txt = str
Dim chars As String
Dim r As String
Dim k As Integer

If Code Then k = 1 Else k = -1

Do While Len(txt) >= GroupNum
chars = Mid(txt, 1, GroupNum)
r = r & SwapChars(chars)
txt = Right(txt, Len(txt) - GroupNum)
Loop

r = r & SwapChars(txt)
SwapStr = r

End Function

Private Function Coding(txt As String, Key As String) As String

Dim r As String: r = txt
Dim i As Integer, N As Integer
For i = 1 To Len(Key)
N = CInt(Mid(Key, i, 1))
r = SwapStr(r, N, True)
Next
Coding = r
End Function

Private Function DeCoding(txt As String, Key As String) As String

Dim r As String: r = txt

Dim i As Integer, N As Integer
For i = Len(Key) To 1 Step -1
N = CInt(Mid(Key, i, 1))
r = SwapStr(r, N, False)
Next
DeCoding = r
End Function
'
'Code for register
'
Private Function Code1(ByVal s As String) As String
Dim i As Integer
Dim tg As String
Dim ch As String * 1
For i = 1 To Len(s)
ch = Mid(s, i, 1)
tg = tg & Asc(ch) - i * 2
If i Mod 2 = 0 And i < Len(s) Then tg = tg & "-"
Next
Code1 = tg
End Function

Private Function Decode1(ByVal s As String) As String
On Error Resume Next
Dim i As Integer
Dim tg As String
Dim ch As String
i = 1
Do While i < Len(s)
If i Mod 5 = 0 And i < Len(s) Then i = i + 1
ch = Mid(s, i, 2)
tg = tg & Chr(CInt(ch) + (Len(tg) + 1) * 2)
i = i + 2
Loop
Decode1 = tg
End Function

Public Function CheckPLSCopyRight() As Boolean

CheckPLSCopyRight = True

Dim Sys32Dir As String: Sys32Dir = WindowsDirectory & "\system32\"

Dim RegFile As String: RegFile = "userpls.dll"

Dim m_a_c As String
m_a_c = Getm_a_cAddress()
m_a_c = Right(m_a_c, Len(m_a_c) - 2)
m_a_c = Coding(m_a_c, "94323")
'Kreg = vbNull

Dim Key As String

If Dir(Sys32Dir & RegFile) = "" Then
'
'Show Registration form
'
With FrmReg
.TxtUserID = m_a_c
.Show 1
Key = .TxtRegCode.Text
Key = Decode1(Key)
Key = DeCoding(Key, "94323")
If Key = m_a_c Then
'
'Create File
'
Open Sys32Dir & RegFile For Output As #1
Print #1, .TxtRegCode.Text
Close #1
MsgBox "Thank you for registration.", vbInformation
Else
MsgBox "Invalid RegKey!", vbCritical
End If
End With
End If
'
'Test registration
'
If Dir(Sys32Dir & RegFile) = "" Then Exit Function

Dim FDate As Date
FDate = FileDate(Sys32Dir & RegFile)
'
'Expired date = 365 = 12 month
'
If ((Now - FDate) > 365 * 5) Or (Now > CDate("30 March 2015")) Then
MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
'Kill Sys32Dir & RegFile
'Empty file
Open Sys32Dir & RegFile For Output As #1
Print #1, ""
Close #1
Exit Function
End If
'
'Open file for checking RegKey
'
Open Sys32Dir & RegFile For Input As #1
Input #1, Key
Close #1
Key = Decode1(Key)
Key = DeCoding(Key, "94323")

'If Key <> m_a_c Then
' MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
' Exit Function
'End If

MyPrompt "Check AutoCad OK"
CheckPLSCopyRight = True
End Function

Private Function FileDate(Fname As String) As Date

Dim FS As Object, F As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set F = FS.GetFile(Fname)
FileDate = F.DateCreated
Set FS = Nothing

End Function

Public Function Getcode(m_a_c As String) As String

Getcode = Coding(m_a_c, "94323")
Getcode = Code1(Getcode)

End Function

SA_DQ · 15/2/13

Câu 3

PHP:

Private Function DeCoding(Txt As String, Key As String) As String
 Dim R As String
 Dim i As Integer, N As Integer
3 R = Txt
 For i = Len(Key) To 1 Step -1
5    N = CInt(Mid(Key, i, 1))
    R = SwapStr(R, N, False)
7 Next
 DeCoding = R
End Function

Trước khi đi vô giải thích hàm tự tạo này làm gì; Mình xin fép trích dịch hàm sang ngôn ngữ Việt, như sau:

Dòng 1 & 2: Khai báo các biến cần dùng trong hàm;
Dòng 3: Gán tham biến Txt vô biến kiểu chuỗi vừa khai báo;
Dòng 4: Thiết lập vòng lặp giảm dần với bước giảm -1 từ chiều dài của tham biến Key đến 1
Vòng lặp kết thúc tại dòng lệnh 7
Dòng 5: Dùng hàm Mid() cắt lấy 1 kí tự theo tham số của vòng lặp & chuyển ký tự này thành ký số.
Dòng 6: Dùng hàm tự tạo SwapStr(R, N, False) để xử lý chuỗi
Dòng 8: Kết quả xử lý được trả về & kết thúc hàm.

Tuy nhiên, đối chiếu với quyển "VBA trong EXCEL, cải thiện & tăng tốc" của Fạm Khắc Duy vừa fát hành, thì hàm thứ ba này, cũng như hàm thứ hai vừa gọi tiềm ẩn rất nhiều bất trắc.
Những điều đó mình rất muốn dừng lại thật lâu để fân tích với bạn.
Đó là dòng lệnh 5.
Dòng này làm 2 việc, việc thứ nhất, là cắt 1 ký tự trong chuỗi tham biến 'Key' & việc thứ hai là biến ký tự này thành ký số;
[thongbao]
Nhưng quá trình thứ 2 này sẽ vấp ngã, một khi người dùng không nhập hoàn toàn là chuỗi các ký số, như "1254", mà là "3214.", hay ngay cả toàn là ký số, như "12091" thì hàm sẽ fá sản![/thongbao]

Good-Luck · 15/2/13

HYen17 đã viết:

PHP:

Tuy nhiên, đối chiếu với quyển "VBA trong EXCEL, cải thiện & tăng tốc" của [COLOR=#ff0000]Fạm Khắc Duy [/COLOR]vừa fát hành, thì hàm thứ ba này, cũng như hàm thứ hai vừa gọi tiềm ẩn rất nhiều bất trắc.[/QUOTE]
thân chao All Member ([COLOR=#0000cd]đặt biệt là Tác Giả "Kyo" của Cuốn Sách "VBA trong EXCEL, cải thiện & tăng tốc" [/COLOR]) !
mình xin đặt câu hỏi ngoài lề chút
cảm phiền cho hỏi cuốn sách của tác giả Kyo "Phạm khắc Duy" vừa phát hành có bán ngoài thị trường ko? và làm thế nào để sở hữu được nó, mình rất mong được sở hữu và tìm hiểu thêm về VBA trong excel , Thanks

[COLOR=#0000cd]cũng nhớ là [/COLOR][COLOR=#ff0000]Nguyễn khắc Duy[/COLOR][COLOR=#0000cd] nhưng thấy LãoThành viên HYen17 gọi thế nên hùa theo, Sorry[/COLOR]

kyo · 15/2/13

Good-Luck đã viết:
thân chao All Member (đặt biệt là Tác Giả "Kyo" của Cuốn Sách "VBA trong EXCEL, cải thiện & tăng tốc" ) !
mình xin đặt câu hỏi ngoài lề chút
cảm phiền cho hỏi cuốn sách của tác giả Kyo "Phạm khắc Duy" vừa phát hành có bán ngoài thị trường ko? và làm thế nào để sở hữu được nó, mình rất mong được sở hữu và tìm hiểu thêm về VBA trong excel , Thanks

Cho kyo đính chính lại tên kyo là Nguyễn Khắc Duy.
Qua Tết GPE mới chính thức phát hành bạn à. Cũng sắp rồi @$@!^%

Kyo.

pdhuyxn2 · 16/2/13

Các Bác giải thích cho em đoạn code quan trọng này nhé

Public Function CheckPLSCopyRight() As Boolean

CheckPLSCopyRight = True

Dim Sys32Dir As String: Sys32Dir = WindowsDirectory & "\system32\"

Dim RegFile As String: RegFile = "userpls.dll"

Dim m_a_c As String
m_a_c = Getm_a_cAddress()
m_a_c = Right(m_a_c, Len(m_a_c) - 2)
m_a_c = Coding(m_a_c, "94323")
'Kreg = vbNull

Dim Key As String

If Dir(Sys32Dir & RegFile) = "" Then
'
'Show Registration form
'
With FrmReg
.TxtUserID = m_a_c
.Show 1
Key = .TxtRegCode.Text
Key = Decode1(Key)
Key = DeCoding(Key, "94323")
If Key = m_a_c Then
'
'Create File
'
Open Sys32Dir & RegFile For Output As #1
Print #1, .TxtRegCode.Text
Close #1
MsgBox "Thank you for registration.", vbInformation
Else
MsgBox "Invalid RegKey!", vbCritical
End If
End With
End If
'
'Test registration
'
If Dir(Sys32Dir & RegFile) = "" Then Exit Function

Dim FDate As Date
FDate = FileDate(Sys32Dir & RegFile)
'
'Expired date = 365 = 12 month
'
If ((Now - FDate) > 365 * 5) Or (Now > CDate("30 March 2015")) Then
MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
'Kill Sys32Dir & RegFile
'Empty file
Open Sys32Dir & RegFile For Output As #1
Print #1, ""
Close #1
Exit Function
End If
'
'Open file for checking RegKey
'
Open Sys32Dir & RegFile For Input As #1
Input #1, Key
Close #1
Key = Decode1(Key)
Key = DeCoding(Key, "94323")

'If Key <> m_a_c Then
' MsgBox "Can't run macro, Acad is busy. Wait for a moment and try again.", vbCritical
' Exit Function
'End If

MyPrompt "Check AutoCad OK"
CheckPLSCopyRight = True
End Function

Private Function FileDate(Fname As String) As Date

Dim FS As Object, F As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set F = FS.GetFile(Fname)
FileDate = F.DateCreated
Set FS = Nothing

End Function

Public Function Getcode(m_a_c As String) As String

Getcode = Coding(m_a_c, "94323")
Getcode = Code1(Getcode)

End Function

nghiepdung · 17/2/13

Em hơi kém về excel xin các pro giải thích hộ em đoạn code này với , càng chi tiết càng tốt ạ , em xin cảm ơn nhiều nhiều .................

Private Sub ListBox1_Click()
ActiveCell.Value = Sheet1.ListBox1.Value
HideTextBox1
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
loc1
End Sub
Private Sub ListBox2_Click()
ActiveCell.Value = Sheet1.ListBox2.Value
HideTextBox2
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
loc2
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.EnableEvents = False
Dim val As String
Dim rng As Range
If Not Intersect(Target, [b3:b100]) Is Nothing Then
Target.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(Target.Value, Sheet2.Range("Nhap"), 2, 0)
Target.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(Target.Value, Sheet2.Range("Nhap"), 3, 0)
End If

If Not Intersect(Target, [C3:C100]) Is Nothing Then
r = Application.WorksheetFunction.Match(Target.Value, Sheet2.Range("TenSP"), 0)
Target.Offset(0, -1).Value = Application.WorksheetFunction.Index(Sheet2.Range("Mahang"), r)
Target.Offset(0, 1).Value = Application.WorksheetFunction.Index(Sheet2.Range("GiaNhap"), r)

End If

ErrHandler:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [b3:b10000]) Is Nothing Then
thaydoi1
Else
HideTextBox1
End If

If Not Intersect(Target, [C3:C10000]) Is Nothing Then
thaydoi2
Else
HideTextBox2
End If

End Sub

Những câu hỏi về code, xin giải thích các code, đề nghị các bạn gửi vào đây

Love Wingchun

Thành viên tiêu biểu

Bad Excel Member

Thành viên tiêu biểu

Thành viên gắn bó

Bad Excel Member

Thành viên tiêu biểu

Thành viên tiêu biểu

Bad Excel Member

Thành viên tiêu biểu

Bad Excel Member

Thành viên mới

0901452không62

Thành viên tiêu biểu

Thành viên mới

Thành viên mới

/(hông là gì!

Thành viên tiêu biểu

Nguyễn Khắc Duy

Thành viên mới

Thành viên mới