Chuyên mục xử lý, gỡ rối code VBA

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

thanhnt1910 · 7/12/17

Thôi dù sao em cũng cảm ơn các anh đã quan tâm đến vấn đề của em, @VetMini , @huuthang_bd , @hpkhuong . Để em tự tìm hiểu, dành câu hỏi cho các anh, chị khác ạ.

VetMini · 7/12/17

thanhnt1910 đã viết:
Sếp e rất là tốt anh nhé

Vậy thì bảo sếp gởi đi học một khoá đào tạo.

trinhvinhtai · 8/12/17

ndu96081631 đã viết:
Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

Chào Thầy

em co code ben dưới hiện tại sử dụng tìm kiếm được 2 file giờ e muốn thêm 1 file nữa ví dụ tên file đó là "3.xls" thầy thêm code giùm với

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode.Value = 13 Then
With Sheet1
If Len(TextBox1.Text) = 0 Then
.Range("A2:K20").ClearContents
Exit Sub
End If
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.Open ("Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0")
.Range("A2:K20").ClearContents
.Range("A2").CopyFromRecordset cn.Execute("select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\1.xls].[A1:K] where [SO]=" & Sheet1.TextBox1.Text & " Union all select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\2.xls].[A1:K] where [SO]=" & Sheet1.TextBox1.Text)
End With
End If

End Sub

ndu96081631 đã viết:
Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

nthuyt3 · 9/12/17

Kính thưa các Thầy cô, anh chị trong diễn đàn.
Em là người đam mê tin học, đặc biệt là excel. Em đã học hỏi được rất rất nhiều từ diễn đàn. Hôm nay em có một câu hỏi đưa lên đây không biết có đúng chỗ không, rất mong Thầy cô, anh chị thông cảm.
Em có cóp một đoạn code trên diễn đàn về ứng dụng. Trong quá trình sử dụng em thấy khi bấm nút coppy thì nó dán tất cả kể cả định dạng. Nay nhờ Thầy cô, anh chi giúp em chỉnh lại để nó chỉ dán số liệu thôi (Paste ->PasteSpecial->Values). Cảm ơn Thầy cô, anh chị nhiều ạ.
code:
Sub copy_6()
On Error Resume Next
Dim basebook As String
Dim mybook As Workbook
Dim fname As String
Dim Mypath As String
Application.ScreenUpdating = False
Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
ChDrive Mypath
ChDir Mypath
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)
mybook.Worksheets(GKI).Activate
Range("a9:aa33").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(basebook).Activate
Sheet6.Select
Range("a7").Select
ActiveSheet.Paste
Range("aa41").Select
Application.CutCopyMode = False
mybook.Close False
Application.ScreenUpdating = True
End Sub

win-sun · 9/12/17

Xin nhờ thầy xem giúp có cách nào tính THNXT nhanh hơn không, khi dữ liệu lên tới 60000 dòng, xin cảm ơn!

thanhnt1910 · 9/12/17

PHP:

Dim cn As Object, Str, Path As String
    Path = PathFolderQuanLy & TenPX & "\" & TenFileBangQDThangTruoc
    Set cn = CreateObject("ADODB.Connection")
    Str = "Select * from [BangChamCong$B5:C] where f1 is not null"
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Extended Properties=""Excel 12.0;HDR=No"";"
    FileBangQD.Sheets("BangLuong").Range("B5").CopyFromRecordset cn.Execute(Str)
    cn.Close

Các anh cho em hỏi đoạn điều kiện "where f1 is not null" là gì ạ.

Hoang2013 · 9/12/17

Vậy bạn cho biết "f1" là gì đi!

thanhnt1910 · 9/12/17

Hoang2013 đã viết:
Vậy bạn cho biết "f1" là gì đi!

à em hiểu rồi anh ạ. Em cảm ơn a

thanhnt1910 · 9/12/17

thanhnt1910 đã viết:
à em hiểu rồi anh ạ. Em cảm ơn a

À anh ơi, đoạn này "Extended Properties=""Excel 12.0;HDR=No"";"" nghĩa là gì ạ.

Hoang2013 · 9/12/17

Hỏi "2 Lúa Long An" í; Mình xa thứ này từ 1995 rồi!

AutoReply · 9/12/17

thanhnt1910 đã viết:
À anh ơi, đoạn này "Extended Properties=""Excel 12.0;HDR=No"";"" nghĩa là gì ạ.

Nghe nói "Extended Properties" được google dịch ra là "Thuộc tính mở rộng" đó bạn.

thanhnt1910 · 9/12/17

AutoReply đã viết:
Nghe nói "Extended Properties" được google dịch ra là "Thuộc tính mở rộng" đó bạn.

Thuộc tính mở rộng "Excel 12.0" là dùng cho excel 2007 trở lên đúng không ạ. Còn cái "HDR=No" hoặc "HDR=Yes" có gì khác nhau ạ.

huonglien1901 · 9/12/17

thanhnt1910 đã viết:
Thuộc tính mở rộng "Excel 12.0" là dùng cho excel 2007 trở lên đúng không ạ. Còn cái "HDR=No" hoặc "HDR=Yes" có gì khác nhau ạ.

Bạn xem thử!
Column headings: By default, it is assumed that the first row of your Excel data source contains columns headings that can be used as field names. If this is not the case, you must turn this setting off, or your first row of data "disappears" to be used as field names. This is done by adding the optional HDR= setting to the Extended Properties of the connection string. The default, which does not need to be specified, is HDR=Yes. If you do not have column headings, you need to specify HDR=No; the provider names your fields F1, F2, etc. Because the Extended Properties string now contains multiple values, it must be enclosed in double quotes itself, plus an additional pair of double quotes to tell Visual Basic to treat the first set of quotes as literal values, as in the following example (where extra spaces have been added for visual clarity).

AutoReply · 9/12/17

thanhnt1910 đã viết:
Thuộc tính mở rộng "Excel 12.0" là dùng cho excel 2007 trở lên đúng không ạ. Còn cái "HDR=No" hoặc "HDR=Yes" có gì khác nhau ạ.

Hình như có bạn gì ở bài #1357 giải thích cho bạn kìa. Tôi học dốt, chữ nghĩa không nhiều nên cũng không biết bạn ấy viết gì. Hi vọng bạn sẽ hiểu hơn tôi.

VetMini · 9/12/17

trinhvinhtai đã viết:

Chào Thầy

em co code ben dưới hiện tại sử dụng tìm kiếm được 2 file giờ e muốn thêm 1 file nữa ví dụ tên file đó là "3.xls" thầy thêm code giùm với

Mã:

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode.Value = 13 Then
       With Sheet1
           If Len(TextBox1.Text) = 0 Then
               .Range("A2:K20").ClearContents
               Exit Sub
           End If
1           Dim cn As Object
           Set cn = CreateObject("ADODB.Connection")
           cn.Open ("Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0")
           .Range("A2:K20").ClearContents
2           .Range("A2").CopyFromRecordset cn.Execute("select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\1.xls].[A1:K] where [SO]=" & Sheet1.TextBox1.Text & " Union all select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\2.xls].[A1:K] where [SO]=" & Sheet1.TextBox1.Text)
       End With
   End If
 
End Sub

Mã:

1           Dim cn As Object
           Dim truyVan As String
           truyVan = " select * from [EXCEL 8.0;Database=" & ThisWorkbook.Path & "\<tenFile>].[A1:K] where [SO]=" & Sheet1.TextBox1.Text
           truyVan = Replace(truyVan, "<tenFile>", "1.xls") & " UNION ALL " & Replace(truyVan, "<tenFile>", "2.xls") & " UNION ALL " & Replace(truyVan, "<tenFile>", "3.xls")
           Set cn = CreateObject("ADODB.Connection")
           cn.Open ("Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0")
           .Range("A2:K20").ClearContents
2           .Range("A2").CopyFromRecordset cn.Execute(truyVan)

VetMini · 9/12/17

thanhnt1910 đã viết:
Thuộc tính mở rộng "Excel 12.0" là dùng cho excel 2007 trở lên đúng không ạ. Còn cái "HDR=No" hoặc "HDR=Yes" có gì khác nhau ạ.

Thì cứ việc thử xem kết quả khác nhau ra sao. Nếu không thấy khác thì đem lên đây hỏi tiếp.

Hoang2013 · 9/12/17

. . . bài #1357 giải thích cho bạn kìa. Tôi học dốt, chữ nghĩa không nhiều nên cũng không biết bạn ấy viết gì. Hi vọng bạn sẽ hiểu hơn tôi.

???

thanhnt1910 · 9/12/17

huonglien1901 đã viết:
Bạn xem thử!
Column headings: By default, it is assumed that the first row of your Excel data source contains columns headings that can be used as field names. If this is not the case, you must turn this setting off, or your first row of data "disappears" to be used as field names. This is done by adding the optional HDR= setting to the Extended Properties of the connection string. The default, which does not need to be specified, is HDR=Yes. If you do not have column headings, you need to specify HDR=No; the provider names your fields F1, F2, etc. Because the Extended Properties string now contains multiple values, it must be enclosed in double quotes itself, plus an additional pair of double quotes to tell Visual Basic to treat the first set of quotes as literal values, as in the following example (where extra spaces have been added for visual clarity).

Em hiểu rồi, em cảm ơn ạ

keke355992 · 10/12/17

E có 1 form, và các TextBox trong đó, dùng 1 button để kiểm tra xem TextBox nào để trống thì báo. Nhưng chẳng nhẽ bao nhiu TextBox là bấy nhiêu Code. Xin nhờ các A/c giúp cho code gọn hơn ạ. E xin cảm ơn !

Mã:

Private Sub CommandButton1_Click()
If TextBox1 = "" Then
        TextBox1.BackStyle = 1
        TextBox1.BackColor = RGB(255, 128, 128)
        MsgBox "KHONG DUOC DE TRONG"
        Exit Sub
End If
If TextBox2 = "" Then
        TextBox2.BackStyle = 1
        TextBox2.BackColor = RGB(255, 128, 128)
        MsgBox "KHONG DUOC DE TRONG"
        Exit Sub
End If
If TextBox3 = "" Then
        TextBox3.BackStyle = 1
        TextBox3.BackColor = RGB(255, 128, 128)
        MsgBox "KHONG DUOC DE TRONG"
        Exit Sub
End If
End Sub

PacificPR · 10/12/17

keke355992 đã viết:
E có 1 form, và các TextBox trong đó, dùng 1 button để kiểm tra xem TextBox nào để trống thì báo. Nhưng chẳng nhẽ bao nhiu TextBox là bấy nhiêu Code. Xin nhờ các A/c giúp cho code gọn hơn ạ. E xin cảm ơn !

Mã:

Private Sub CommandButton1_Click() If TextBox1 = "" Then TextBox1.BackStyle = 1 TextBox1.BackColor = RGB(255, 128, 128) MsgBox "KHONG DUOC DE TRONG" Exit Sub End If If TextBox2 = "" Then TextBox2.BackStyle = 1 TextBox2.BackColor = RGB(255, 128, 128) MsgBox "KHONG DUOC DE TRONG" Exit Sub End If If TextBox3 = "" Then TextBox3.BackStyle = 1 TextBox3.BackColor = RGB(255, 128, 128) MsgBox "KHONG DUOC DE TRONG" End If End Sub

Anh thử như thế này xem sao:

PHP:

Private Sub CommandButton1_Click()
    Dim Tb
For Each Tb In UserForm1.Controls
    If UCase(TypeName(Tb)) = "TEXTBOX" Then
        If Tb = "" Then
            Tb.BackStyle = 1
            Tb.BackColor = RGB(255, 128, 128)
            MsgBox "KHONG DUOC DE TRONG"        
        End If
    End If
Next Tb
End Sub

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại GPE

Thành viên mới

Ăn cùng góc phố

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

Thành viên mới

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

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên gắn bó

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

Thành viên mới

GPE là ngôi nhà thứ 2 của tôi!!!

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

Ăn cùng góc phố

Ăn cùng góc phố

Thành viên gắn bó

Thành viên mới

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

File đính kèm

Thành viên mới

Facebook

Group