Chuyên đề giải đáp những thắc mắc về code VBA

maytinhvp01 · 31/7/13

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

CHAOQUAY · 29/5/20

PacificPR đã viết:
Dạ đến khi tắt Excel ạ

Cái bài nghỉ 10s, tiếp tục, rồi lại 10s tiếp nghe giống như là búa máy đóng cọc ý bạn nhỉ

domjnjc · 29/5/20

CHAOQUAY đã viết:
Chạy đến khi nào thì thôi?

Dạ, chạy mãi mãi ạ, kiểu như chỉ tạm dừng 30s khi các ô từ H1 đến J1 có xuất hiện "true" ạ

CHAOQUAY · 29/5/20

domjnjc đã viết:
Dạ, chạy mãi mãi ạ, kiểu như chỉ tạm dừng 30s khi các ô từ H1 đến J1 có xuất hiện "true" ạ

Sửa lại 1 tí cho nhanh.
Bạn có thể sửa lại giá trị của tm = bao nhiêu thì tùy.
Cái này nếu thích dừng có thể nhấn phím Esc

Mã:

#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If


Sub Test()
Dim tm

Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30)
tm = 100
If Range("H1") = True Then
    If Range("I1") = True Then
        If Range("J1") = True Then
            tm = 300
        End If
    End If
End If
Sleep (tm)
Test

'alertTime = Now + TimeValue("00:00:10")
'Application.OnTime alertTime, "Test"

End Sub
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

domjnjc · 30/5/20

CHAOQUAY đã viết:

Sửa lại 1 tí cho nhanh.
Bạn có thể sửa lại giá trị của tm = bao nhiêu thì tùy.
Cái này nếu thích dừng có thể nhấn phím Esc

Mã:

#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If


Sub Test()
Dim tm

Range("A1:A30").Value = UniqueRandomNum(1, 1000, 30)
tm = 100
If Range("H1") = True Then
    If Range("I1") = True Then
        If Range("J1") = True Then
            tm = 300
        End If
    End If
End If
Sleep (tm)
Test

'alertTime = Now + TimeValue("00:00:10")
'Application.OnTime alertTime, "Test"

End Sub
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

Em cảm ơn nhiều ạ, nhưng khi em ấn vào nút button click thì chỉ chay liện tục mà không dừng lại khi H1 hiện true a ạ, còn không bấm vào button thì không thấy tự động chọn ngẫu nhiên tập số sau 10s ạ,
Nếu không được thì em muốn nó chạy đến khi ô H1 xuất hiện giá trị true thì dừng hẳn, a giúp e với ạ!

CHAOQUAY · 30/5/20

domjnjc đã viết:
Em cảm ơn nhiều ạ, nhưng khi em ấn vào nút button click thì chỉ chay liện tục mà không dừng lại khi H1 hiện true a ạ, còn không bấm vào button thì không thấy tự động chọn ngẫu nhiên tập số sau 10s ạ

Bạn bấm vào thì nó mới chạy. Ít nhất phải bấm 1 lần.
Theo yêu cầu màu xanh của bài trước, khi H1=true & I1=true & J1=true thì sẽ dừng lâu hơn.
Có phải ý của bạn như phần chữ xanh?

domjnjc đã viết:
File dưới e tham khảo của một pro trong forum về cách tạo ngẫu nhiên dữ liệu số ngẫu nhiên không trùng, em thêm được đoạn mã chạy tự động sau mỗi 10s, nhưng mục đích của em cuối cùng là: cứ sau 10s, Sub tự động chạy cho đến khi H1 đến J1 hiển thị giá trị "true" thì dừng lại 30s, nhờ các pro giúp e với ạ!

Bài đã được tự động gộp: 30/5/20

domjnjc đã viết:
Nếu không được thì em muốn nó chạy đến khi ô H1 xuất hiện giá trị true thì dừng hẳn, a giúp e với ạ!

Mã:

If Range("H1") = True Then

Nếu vậy bạn tìm dòng bên trên.
Chèn thêm phía dưới dòng lệnh dưới đây

Mã:

Exit Sub

domjnjc · 30/5/20

CHAOQUAY đã viết:
Bạn bấm vào thì nó mới chạy. Ít nhất phải bấm 1 lần.
Theo yêu cầu màu xanh của bài trước, khi H1=true & I1=true & J1=true thì sẽ dừng lâu hơn.
Có phải ý của bạn như phần chữ xanh?

Dạ, chỉ cần bất cứ 1 ô nào trong 3 ô H1,I1, J1 hiển thị giá trị true thì dừng lâu hơn 30s, em thay thế bằng OR được rồi ạ

CHAOQUAY đã viết:
Nếu vậy bạn tìm dòng bên trên.
Chèn thêm phía dưới dòng lệnh dưới đây

Dạ em cảm ơn, em làm được rồi ạ

Cu Tồ · 30/5/20

Mã:

Sub mo_file()
Workbooks.Open Filename:=Range("F9"), Password:=Range("G9")
End Sub

chào anh chị em trong diễn đàn GPE
các anh chị cho mình hỏi là trong đoạn code dưới đây thì sửa làm sao để nó tự nhập mật khẩu ở ô G9 ạ?

BlackHorse1123 · 10/6/20

Các bác có thể cho em đoạn code lưu 1 vùng chọn trong exel thành 1 sheet mới trong 1 trang tính khác được không ạ. Em mấy hôm tìm mãi mà không thấy. :'(

Kiều Mạnh · 13/6/20

Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

1/ Giá trị trong TextBox1 là địa chỉ ô bất kỳ trên bảng tính, do mình nhập thủ công
2/ Nếu nhập vào TextBox1 sai so với địa chỉ ô bất kỳ trên bảng tính báo lỗi hay Xóa
3/ Viết code check cái giá trị nhập thủ công trên TextBox1
================
VD nhập Sai: 11, aaa, mmm
VD nhập đúng: A1 To A1048576, hay B1 to B1048576 ...

Code kiểu như sau mà mình chưa hình dung ra cách viết và xử lý lỗi

Mã:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Rem chi cho nhap vào TextBox1 giá tri tuong duong dia chi Cells tren Sheet
    If TextBox1.Value <> Range("????") Then
        TextBox1.Value = Empty
    Else
        Exit Sub
    End If
End Sub

Rất mong sự trợ giúp
xin cảm ơn

ongke0711 · 13/6/20

Có 1 cách là bạn tách chữ và số: comboBox cho chữ, textbox cho số. Khi đó bạn có thể đưa danh sách các ký tự cột của bảng tính Exce làm Row Source cho comboBoxl, Textbox thì số thì không lớn hơn 1.048.576

HieuCD · 13/6/20

Kiều Mạnh đã viết:
Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

1/ Giá trị trong TextBox1 là địa chỉ ô bất kỳ trên bảng tính, do mình nhập thủ công
2/ Nếu nhập vào TextBox1 sai so với địa chỉ ô bất kỳ trên bảng tính báo lỗi hay Xóa
3/ Viết code check cái giá trị nhập thủ công trên TextBox1
================
VD nhập Sai: 11, aaa, mmm
VD nhập đúng: A1 To A1048576, hay B1 to B1048576 ...

Code kiểu như sau mà mình chưa hình dung ra cách viết và xử lý lỗi

Mã:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Rem chi cho nhap vào TextBox1 giá tri tuong duong dia chi Cells tren Sheet If TextBox1.Value <> Range("????") Then TextBox1.Value = Empty Else Exit Sub End If End Sub

Rất mong sự trợ giúp
xin cảm ơn

Ví dụ

Mã:

On Error Resume Next
a = TypeName(Range(TextBox1.Value))
If Err > 1 Then 'Lổi
  '...
  On Error GoTo 0
End If

Kiều Mạnh · 13/6/20

HieuCD đã viết:
HieuCD đã viết:

Ví dụ

Mã:

On Error Resume Next a = TypeName(Range(TextBox1.Value)) If Err > 1 Then 'Lổi '... On Error GoTo 0 End If

Nhấp chuột vào đây để mở rộng...

Ví dụ

Mã:

On Error Resume Next a = TypeName(Range(TextBox1.Value)) If Err > 1 Then 'Lổi '... On Error GoTo 0 End If

Mai thứ xem sao đang trên điện thoại

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Các Bạn cho mình hỏi chút
Có cách nào chỉ cho nhập vào TextBox1 thủ công giá trị tương đương với địa chỉ ô trên bảng tính bất kỳ không ??

Đưa vào sự kiện BeforeUpdate. Dùng sự kiện KeyDown thì vừa nhấn phím ký tự đầu tiên đã bị chửi. sự kiện BeforeUpdate còn có tham số Cancel cho phép buộc ở lại để sửa nếu sai

PHP:

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo Loi
    Set Rng = ActiveSheet.Range(TextBox1.Value)
    Set Rng = Nothing: Exit Sub
Loi:
    MsgBox "Do chet tiet! Không phai dia chi o."
    Cancel = True
    Exit Sub
End Sub

Kiều Mạnh · 14/6/20

ptm0412 đã viết:
Đưa vào sự kiện BeforeUpdate. Dùng sự kiện KeyDown thì vừa nhấn phím ký tự đầu tiên đã bị chửi. sự kiện BeforeUpdate còn có tham số Cancel cho phép buộc ở lại để sửa nếu sai

PHP:

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) On Error GoTo Loi Set Rng = ActiveSheet.Range(TextBox1.Value) Set Rng = Nothing: Exit Sub Loi: MsgBox "Do chet tiet! Không phai dia chi o." Cancel = True Exit Sub End Sub

Em mới thử xong kiểu gì nó củng IM RE hết

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Em mới thử xong kiểu gì nó củng IM RE hết

Tại có duy nhất 1 control nên không xảy ra sự kiện

(có đi đâu đâu mà buộc ở lại)
Vẽ thêm 1 control bất kỳ đi
Có vậy mà like xong đành đoạn gỡ ra

Kiều Mạnh · 14/6/20

ptm0412 đã viết:
Tại có duy nhất 1 control nên không xảy ra sự kiện (có đi đâu đâu mà buộc ở lại)
Vẽ thêm 1 control bất kỳ đi
Có vậy mà like xong đành đoạn gỡ ra

Chính xác cái Em cần ... Mà tiện cho Em hỏi chút mà cớ sao phải cho 2 control trở lên nó mới có tác dụng là sao ???!!!!!!!!

ptm0412 · 14/6/20

Kiều Mạnh đã viết:
Chính xác cái Em cần ... Mà tiện cho Em hỏi chút mà cớ sao phải cho 2 control trở lên nó mới có tác dụng là sao ???!!!!!!!!

Các sự kiện Before update, after update, enter, exit của 1 control (loại nhập liệu) chỉ xảy ra khi vào hoặc ra khỏi control. Phải có control thứ 2 mới có chuyện từ đâu vào hoặc ra rồi đi đâu chứ?
Thí dụ như bị nhốt trong nhà (chung quanh không có gì hết) thì làm gì có chuyện mở cửa đi chơi hay về mở cửa vào nhà

BuiQuangThuan · 18/6/20

Em xin chào các thầy cô, anh chị trên diễn đàn.
Có 1 thắc mắc này nhờ mọi người trả lời giúp được không ạ?

1. Hiện tại em đang muốn duyệt qua từng file được chọn ( Ví dụ kích vô nút nó sẽ hiện lên đường dẫn foder => chọn những file muốn chọn).

Sau đó nó sẽ mở từ file lên và đưa vùng dữ liệu (vùng này cũng được khai báo trước) trong 1 sheet chỉ định vào mảng.
Mỗi 1 file mở lên sẽ được tạo thành 1 mảng riêng biệt ( Chẳng hạn em chọn 3 file, thì nó sẽ tạo ra 3 mảng Arr trong Locals).

2. Nếu như làm được 1. Vùng dữ liệu và tên sheet lấy dữ liệu trong file con sẽ khai báo bằng biến trước được không ạ?

Do đây là cách em nghĩ. Không biết có khả thi không? Nên mạn phép nhờ thầy cô và mọi người chỉ giúp ạ.
Em xin cám ơn!

Hoàng Nhật Phương · 22/6/20

Xin chào các bạn:
Hiện OT mong muốn sau khi chạy được dữ liệu sẽ xuất ra được kết quả là:

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
(Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
(Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
(Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
(Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhưng OT đã loay hoay suốt với đoạn code bên dưới , kết quả ra xuất ra không mong muốn, các dấu ngoặc "(" không xen kẽ sau các dấu "," như trên :

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(((((Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhờ các bạn sửa giúp đoạn code trên cho OT với ạ.

Mã:

Option Explicit

Sub Test()

    Dim sh As Worksheet, arr As Variant, s As String
    Dim I As Long, J As Long, cName As String, iData As String
    Set sh = ThisWorkbook.Worksheets("DL")
    
    arr = sh.Range("D1").Resize(6, 5).Value2
    For J = 1 To UBound(arr, 2)
        If J = 1 Then
            cName = arr(1, J)
        Else
            cName = cName & "," & arr(1, J)
        End If
    Next J
          
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = "(" & iData & ")"
    Next I

    s = "INSERT INTO TABLE_NAME (" & cName & ") VALUES " & iData
    
    Debug.Print s
          
End Sub

Hoàng Nhật Phương · 22/6/20

Nguyễn Hoàng Nhật Phương đã viết:

Xin chào các bạn:
Hiện OT mong muốn sau khi chạy được dữ liệu sẽ xuất ra được kết quả là:

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
(Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
(Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
(Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
(Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhưng OT đã loay hoay suốt với đoạn code bên dưới , kết quả ra xuất ra không mong muốn, các dấu ngoặc "(" không xen kẽ sau các dấu "," như trên :

Mã:

INSERT INTO TABLE_NAME (Col1,Col2,Col3,Col4,Col5) VALUES
(((((Col1_data1,Col2_data1,Col3_data1,Col4_data1,Col5_data1),
Col1_data2,Col2_data2,Col3_data2,Col4_data2,Col5_data2),
Col1_data3,Col2_data3,Col3_data3,Col4_data3,Col5_data3),
Col1_data4,Col2_data4,Col3_data4,Col4_data4,Col5_data4),
Col1_data5,Col2_data5,Col3_data5,Col4_data5,Col5_data5)

Nhờ các bạn sửa giúp đoạn code trên cho OT với ạ.

Mã:

Option Explicit

Sub Test()

    Dim sh As Worksheet, arr As Variant, s As String
    Dim I As Long, J As Long, cName As String, iData As String
    Set sh = ThisWorkbook.Worksheets("DL")
   
    arr = sh.Range("D1").Resize(6, 5).Value2
    For J = 1 To UBound(arr, 2)
        If J = 1 Then
            cName = arr(1, J)
        Else
            cName = cName & "," & arr(1, J)
        End If
    Next J
         
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = "(" & iData & ")"
    Next I

    s = "INSERT INTO TABLE_NAME (" & cName & ") VALUES " & iData
   
    Debug.Print s
         
End Sub

Cảm ơn mọi người OT đã xử lý được rồi ạ, mặc dù nó hơi dài ạ:

Mã:

...
    For I = 2 To UBound(arr, 1)
        For J = 1 To UBound(arr, 2)
            s = arr(I, J)
            If J = 1 And I = 2 Then
                iData = "(" & s
            ElseIf J = 1 Then
                iData = iData & ",(" & s
            Else
                iData = iData & "," & s
            End If
        Next J
        iData = iData & ")"
    Next I
    ...

Nếu Bạn nào có cách làm khác cho OT tham khảo với ạ.

Chuyên đề giải đáp những thắc mắc về code VBA

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

Thành viên mới

I don't program, I beat code into submission!!!

File đính kèm

Thành viên gắn bó

Chuyên gia GPE

I don't program, I beat code into submission!!!

Bad Excel Member

I don't program, I beat code into submission!!!

Bad Excel Member

I don't program, I beat code into submission!!!

Bad Excel Member

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

Đếm ngược thời gian