Giúp em code load dữ liệu từ file đang đóng vào listbox trên form của file đang mở (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Q

quoc nhat

Thành viên tiêu biểu
Tham gia
8/3/12
Bài viết
567
Được thích
43
Nghề nghiệp
cán bộ ngành y tế
Kính nhờ các anh chị chỉ giáo giúp.
Vì muốn giảm dung lượng cho file làm việc chính nên em đã tạo ra một File phụ để chứa dữ liệu có sẵn " DATA".
cụ thể trong file chính là em muốn chọn dữ liệu trên form để làm việc nhưng form lại lấy dữ liệu từ File đang đóng (tên file " DATA")
Vấn đề này quá khó với em nên nhờ các anh chị giúp sức.
Em cảm ơn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
quoc nhat đã viết:
Kính nhờ các anh chị chỉ giáo giúp.
Vì muốn giảm dung lượng cho file làm việc chính nên em đã tạo ra một File phụ để chứa dữ liệu có sẵn " DATA".
cụ thể trong file chính là em muốn chọn dữ liệu trên form để làm việc nhưng form lại lấy dữ liệu từ File đang đóng (tên file " DATA")
Vấn đề này quá khó với em nên nhờ các anh chị giúp sức.
Em cảm ơn
Nhấp chuột vào đây để mở rộng...
Chép code sau vào form

[GPECODE=sql]Private Sub UserForm_Initialize()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT * FROM [icd10$] WHERE STT IS NOT NULL", cn

If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
rs.Close
End If
cn.Close
Set rs = Nothing
Set cn = Nothing

End Sub[/GPECODE]
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Chép code sau vào form

[GPECODE=sql]Private Sub UserForm_Initialize()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT * FROM [icd10$] WHERE STT IS NOT NULL", cn

If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
rs.Close
End If
cn.Close
Set rs = Nothing
Set cn = Nothing

End Sub[/GPECODE]
Nhấp chuột vào đây để mở rộng...
Cảm ơn thầy đã giúp em .
Thầy ơi đã lấy được dữ liệu rồi , em xin phép làm phiền thầy lần nữa là thầy có thể giúp em đoạn code tìm kiếm theo các tiêu chí như ở trên Form được không?
bao gồm : STT, tên bệnh và mã bệnh.
Thầy ráng giúp em với
em cảm ơn thầy
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Chép code sau vào form

[GPECODE=sql]Private Sub UserForm_Initialize()
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
rs.Open "SELECT * FROM [icd10$] WHERE STT IS NOT NULL", cn

If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
rs.Close
End If
cn.Close
Set rs = Nothing
Set cn = Nothing

End Sub[/GPECODE]
Nhấp chuột vào đây để mở rộng...


Nhưng nếu dưx liệu ở 1 Folder khác và từ nhiều file khác thì phải làm thế nào cho mình biết với .
Thanks!!!
 
Upvote 0
quoc nhat đã viết:
Cảm ơn thầy đã giúp em .
Thầy ơi đã lấy được dữ liệu rồi , em xin phép làm phiền thầy lần nữa là thầy có thể giúp em đoạn code tìm kiếm theo các tiêu chí như ở trên Form được không?
bao gồm : STT, tên bệnh và mã bệnh.
Thầy ráng giúp em với
em cảm ơn thầy
Nhấp chuột vào đây để mở rộng...

Bạn muốn tìm từ gần giống hay là chính xác?
phungg đã viết:
Nhưng nếu dưx liệu ở 1 Folder khác và từ nhiều file khác thì phải làm thế nào cho mình biết với .
Thanks!!!
Nhấp chuột vào đây để mở rộng...

Bạn chỉ cần điều chỉnh đường dẫn hợp lý là được.

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _ ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
quoc nhat đã viết:
Thầy hỏi lại vậy em mừng quá
Tìm gần giống thôi thầy ơi
Thầy ráng giúp em nghe
em cảm ơn thầy trước
Nhấp chuột vào đây để mở rộng...
Sáng mai tôi sẽ coi tiếp nha bạn. Nếu giờ đến sáng mai chưa ai giúp, tôi sẽ giúp bạn. Giờ đến giờ phải về rồi.

Tái bút: Bạn đừng gọi tôi là thầy, thật sự tôi không dám nhận, có thể tôi chỉ biết cái này nhưng chưa hẳn tôi biết nhiều hơn những cái bạn biết. Hãy gọi nhau là bạn nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Bạn muốn tìm từ gần giống hay là chính xác?


Bạn chỉ cần điều chỉnh đường dẫn hợp lý là được.
Nhấp chuột vào đây để mở rộng...


Mình cảm ơn ! và cho mình biết thêm một vấn đề nữa là : Dùng commandbutton mở hộp thoại "Open" mà chỉ có những loại File có phần mở rộng là ".xls" xuất hiện.

Giúp mình với nhé mình thấy bế tắc quá!!
 
Upvote 0
quoc nhat đã viết:
Thầy hỏi lại vậy em mừng quá
Tìm gần giống thôi thầy ơi
Thầy ráng giúp em nghe
em cảm ơn thầy trước
Nhấp chuột vào đây để mở rộng...
Chép code sau vào form nhé.
[GPECODE=sql]Option Explicit
Dim cn As Object, rs As Object
Dim strDK As String

Private Sub CommandButton1_Click()
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE UCASE(" & strDK & ") LIKE '" & UCase(tbxTuKhoa.Text) & "%'", cn
If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
End If
rs.Close: Set rs = Nothing
End Sub

Private Sub optMaBenh_Change()
strDK = "MABENH"
End Sub

Private Sub optSTT_Change()
strDK = "STT"
End Sub

Private Sub optTenBenh_Change()
strDK = "TENBENH"
End Sub

Private Sub UserForm_Initialize()
MoKetNoi
Set rs = CreateObject("ADODB.Recordset")
optSTT.Value = True
rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE STT IS NOT NULL", cn
If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
End If
rs.Close: Set rs = Nothing
End Sub
Sub MoKetNoi()
Set cn = CreateObject("ADODB.Connection")
If cn.State = 1 Then cn.Close
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"

End Sub

[/GPECODE]

Lưu ý: File data bạn chỉnh lại tiêu đề cột lần lượt là STT, MABENH, TENBENH. Không nên ghi tiếng Việt có dấu cho tên cột nhé.
 
Upvote 0
phungg đã viết:
Mình cảm ơn ! và cho mình biết thêm một vấn đề nữa là : Dùng commandbutton mở hộp thoại "Open" mà chỉ có những loại File có phần mở rộng là ".xls" xuất hiện.

Giúp mình với nhé mình thấy bế tắc quá!!
Nhấp chuột vào đây để mở rộng...
Thử với code sau:

Mã: 
    Dim strFileName As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls"
        If .Show = -1 Then
            strFileName = .SelectedItems(1)
            MsgBox strFileName
        End If
    End With

Bạn nối cái biến strFileName đó vào chuổi kết nối là được.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Thử với code sau:

Mã: 
    Dim strFileName As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls"
        If .Show = -1 Then
            strFileName = .SelectedItems(1)
            MsgBox strFileName
        End If
    End With

Bạn nối cái biến strFileName đó vào chuổi kết nối là được.
Nhấp chuột vào đây để mở rộng...


Tuyệt vời quá bạn ơi mình cảm ơn nhiều.
Bạn có thể giúp mình làm thế nào để tự động đoc số liệu lần lượt từ các File đó, nếu số liệu nào phù hợp thì đưa lên textbox Userform
Mình có thể biết và quen bạn đươc không !!!
 
Upvote 0
phungg đã viết:
Tuyệt vời quá bạn ơi mình cảm ơn nhiều.
Bạn có thể giúp mình làm thế nào để tự động đoc số liệu lần lượt từ các File đó, nếu số liệu nào phù hợp thì đưa lên textbox Userform
Mình có thể biết và quen bạn đươc không !!!
Nhấp chuột vào đây để mở rộng...

Bạn gửi file miêu tả xem coi như thế nào nhé.
 
Upvote 0
Bạn bớt chút thời gian giúp mình nhé. Mình muốn bạn chỉ cho mình cách tự động đọc lần lượt các file có trong hộp thoại open mà khi mình đã chọn Folder.
Thanks!!!
 
Upvote 0
phungg đã viết:
Bạn bớt chút thời gian giúp mình nhé. Mình muốn bạn chỉ cho mình cách tự động đọc lần lượt các file có trong hộp thoại open mà khi mình đã chọn Folder.
Thanks!!!
Nhấp chuột vào đây để mở rộng...

Bạn test code sau:

Mã: 
    Dim strFileName As Variant
    Dim i As Byte
    strFileName = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
                  Title:="Select files", MultiSelect:=True)
    If IsArray(strFileName) Then
        For i = LBound(strFileName) To UBound(strFileName)
           MsgBox strFileName(i)
        Next i
    End If
 
Upvote 0
Mình gửi File mô phỏng:
mục đích là khi nhấn nút "Find" thì hộp thoại Open hiện ra sau khi chon Folder để hiển thị ra các File1-5(số lượng file này không xác định) và sẽ tự động quét tất cả các file đó nếu file nào có Code đúng = số trên Lable1(số này sẽ tự động thay đổi) thì lấy các giá trị Value1,2,3.

Giúp mình với nhe.
Thanks!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Chép code sau vào form nhé.
[GPECODE=sql]Option Explicit
Dim cn As Object, rs As Object
Dim strDK As String

Private Sub CommandButton1_Click()
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE UCASE(" & strDK & ") LIKE '" & UCase(tbxTuKhoa.Text) & "%'", cn
If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
End If
rs.Close: Set rs = Nothing
End Sub

Private Sub optMaBenh_Change()
strDK = "MABENH"
End Sub

Private Sub optSTT_Change()
strDK = "STT"
End Sub

Private Sub optTenBenh_Change()
strDK = "TENBENH"
End Sub

Private Sub UserForm_Initialize()
MoKetNoi
Set rs = CreateObject("ADODB.Recordset")
optSTT.Value = True
rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE STT IS NOT NULL", cn
If Not (rs.bof And rs.EOF) Then
Me.lstDanhMuc.ColumnCount = rs.Fields.Count
Me.lstDanhMuc.Column = rs.getrows()
End If
rs.Close: Set rs = Nothing
End Sub
Sub MoKetNoi()
Set cn = CreateObject("ADODB.Connection")
If cn.State = 1 Then cn.Close
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"

End Sub

[/GPECODE]

Lưu ý: File data bạn chỉnh lại tiêu đề cột lần lượt là STT, MABENH, TENBENH. Không nên ghi tiếng Việt có dấu cho tên cột nhé.
Nhấp chuột vào đây để mở rộng...
Xin lỗi em còn nhỏ tuổi thôi không giám gọi anh là bạn.
Thôi xưng anh và em cho tiện
em xl hom qua tới giờ em bận quá giờ mới vào xem được để em kiểm tra thế nào rồi có phản hồi lại với anh nhé
Cảm ơn anh!
 
Upvote 0
Không được anh Hai lúa miền tây ơi!
Nó báo lỗi sub Moketnoi
Em gửi ảnh cho anh xem nhé
mà không biết sao mà khi em copy vào môi trường soạn VBA lại có mấy dòng chữ màu đỏ như trong ảnh nữa.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
quoc nhat đã viết:
Không được anh Hai lúa miền tây ơi!
Nó báo lỗi sub Moketnoi
Em gửi ảnh cho anh xem nhé
mà không biết sao mà khi em copy vào môi trường soạn VBA lại có mấy dòng chữ màu đỏ như trong ảnh nữa.
Nhấp chuột vào đây để mở rộng...
Lạ nhỉ, vậy chạy thử code sau nhé:
Mã: 
Option Explicit
Dim strDK As String

Private Sub CommandButton1_Click()
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
               ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE UCASE(" & strDK & ") LIKE '" & UCase(tbxTuKhoa.Text) & "%'", cn
    If Not (rs.bof And rs.EOF) Then
        Me.lstDanhMuc.ColumnCount = rs.Fields.Count
        Me.lstDanhMuc.Column = rs.getrows()
    End If
    rs.Close:    Set rs = Nothing
    cn.Close:    Set cn = Nothing
End Sub

Private Sub optMaBenh_Change()
    strDK = "MABENH"
    tbxTuKhoa.Text = ""
End Sub

Private Sub optSTT_Change()
    strDK = "STT"
    tbxTuKhoa.Text = ""
End Sub

Private Sub optTenBenh_Change()
    strDK = "TENBENH"
    tbxTuKhoa.Text = ""
End Sub

Private Sub UserForm_Initialize()
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
               ";Extended Properties=""Excel 8.0;HDR=Yes;"";"

    Set rs = CreateObject("ADODB.Recordset")
    optSTT.Value = True
    rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE STT IS NOT NULL", cn
    If Not (rs.bof And rs.EOF) Then
        Me.lstDanhMuc.ColumnCount = rs.Fields.Count
        Me.lstDanhMuc.Column = rs.getrows()
    End If
    rs.Close:    Set rs = Nothing
    cn.Close:    Set cn = Nothing
End Sub
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Lạ nhỉ, vậy chạy thử code sau nhé:
Mã: 
Option Explicit
Dim strDK As String

Private Sub CommandButton1_Click()
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
               ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE UCASE(" & strDK & ") LIKE '" & UCase(tbxTuKhoa.Text) & "%'", cn
    If Not (rs.bof And rs.EOF) Then
        Me.lstDanhMuc.ColumnCount = rs.Fields.Count
        Me.lstDanhMuc.Column = rs.getrows()
    End If
    rs.Close:    Set rs = Nothing
    cn.Close:    Set cn = Nothing
End Sub

Private Sub optMaBenh_Change()
    strDK = "MABENH"
    tbxTuKhoa.Text = ""
End Sub

Private Sub optSTT_Change()
    strDK = "STT"
    tbxTuKhoa.Text = ""
End Sub

Private Sub optTenBenh_Change()
    strDK = "TENBENH"
    tbxTuKhoa.Text = ""
End Sub

Private Sub UserForm_Initialize()
    Dim cn As Object, rs As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Data.xls;" & _
               ";Extended Properties=""Excel 8.0;HDR=Yes;"";"

    Set rs = CreateObject("ADODB.Recordset")
    optSTT.Value = True
    rs.Open "SELECT STT, MABENH, TENBENH FROM [icd10$] WHERE STT IS NOT NULL", cn
    If Not (rs.bof And rs.EOF) Then
        Me.lstDanhMuc.ColumnCount = rs.Fields.Count
        Me.lstDanhMuc.Column = rs.getrows()
    End If
    rs.Close:    Set rs = Nothing
    cn.Close:    Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Vẫn không được anh ơi
em gửi lại file cho anh xem nhé
 

File đính kèm

Upvote 0
phungg đã viết:
Mình gửi File mô phỏng:
mục đích là khi nhấn nút "Find" thì hộp thoại Open hiện ra sau khi chon Folder để hiển thị ra các File1-5 và sẽ tự động quét tất cả các file đó nếu file nào có Code đúng = số trên Lable1(số này sẽ tự động thay đổi) thì lấy các giá trị Value1,2,3.

Giúp mình với nhe.
Thanks!
Nhấp chuột vào đây để mở rộng...
Đã có lần tôi đề nghị bạn gửi file mô phỏng mà bạn không chịu:

Mã: 
Private Sub cmdTest_Click()
    Dim strFileName As Variant
    Dim i As Byte, strKQ As String
    Dim cn As Object, rs As Object
    strFileName = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
                  Title:="Select files", MultiSelect:=True)
    If IsArray(strFileName) Then
        For i = LBound(strFileName) To UBound(strFileName)
            Set cn = CreateObject("ADODB.Connection")
            Set rs = CreateObject("ADODB.Recordset")
            cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName(i) & _
                       ";Extended Properties=""Excel 8.0;HDR=No;"";"
            rs.Open "SELECT * " & _
                    "FROM [AOS$] " & _
                    "WHERE F2='" & Label1.Caption & "'", cn
            If rs.EOF Then
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                        "Khong thoa dieu kien.", vbOKOnly + vbCritical, "Tim kiem"
                rs.Close
            Else
                rs.Close
                rs.Open "SELECT * FROM [AOS$] ", cn
                rs.MoveFirst
                Do While Not rs.EOF
                    strKQ = strKQ & rs![F1] & " - " & rs![F2] & vbNewLine
                    rs.MoveNext
                Loop
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                       "Co ket qua nhu sau: " & vbNewLine & strKQ
                rs.Close
            End If
            Set rs = Nothing
            cn.Close:    Set cn = Nothing
        Next i
    End If
End Sub
Lưu ý: Khi nhấn nút test, hộp thoại mở ra, bạn nhấn giử phím ctrl+chọn bao nhiêu file tùy ý rồi nhấn Open nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hai Lúa Miền Tây đã viết:
Đã có lần tôi đề nghị bạn gửi file mô phỏng mà bạn không chịu:

Mã: 
Private Sub cmdTest_Click()
    Dim strFileName As Variant
    Dim i As Byte, strKQ As String
    Dim cn As Object, rs As Object
    strFileName = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
                  Title:="Select files", MultiSelect:=True)
    If IsArray(strFileName) Then
        For i = LBound(strFileName) To UBound(strFileName)
            Set cn = CreateObject("ADODB.Connection")
            Set rs = CreateObject("ADODB.Recordset")
            cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName(i) & _
                       ";Extended Properties=""Excel 8.0;HDR=No;"";"
            rs.Open "SELECT * " & _
                    "FROM [AOS$] " & _
                    "WHERE F2='" & Label1.Caption & "'", cn
            If rs.EOF Then
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                        "Khong thoa dieu kien.", vbOKOnly + vbCritical, "Tim kiem"
                rs.Close
            Else
                rs.Close
                rs.Open "SELECT * FROM [AOS$] ", cn
                rs.MoveFirst
                Do While Not rs.EOF
                    strKQ = strKQ & rs![F1] & " - " & rs![F2] & vbNewLine
                    rs.MoveNext
                Loop
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                       "Co ket qua nhu sau: " & vbNewLine & strKQ
                rs.Close
            End If
            Set rs = Nothing
            cn.Close:    Set cn = Nothing
        Next i
    End If
End Sub
Lưu ý: Khi nhấn nút test, hộp thoại mở ra, bạn nhấn giử phím ctrl+chọn bao nhiêu file tùy ý rồi nhấn Open nhé.
Nhấp chuột vào đây để mở rộng...

Mình cảm ơn nhiều!!!
bây giờ mình sẽ chạy thử
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Đã có lần tôi đề nghị bạn gửi file mô phỏng mà bạn không chịu:

Mã: 
Private Sub cmdTest_Click()
    Dim strFileName As Variant
    Dim i As Byte, strKQ As String
    Dim cn As Object, rs As Object
    strFileName = Application.GetOpenFilename("Excel Files (*.xls), *.xls", _
                  Title:="Select files", MultiSelect:=True)
    If IsArray(strFileName) Then
        For i = LBound(strFileName) To UBound(strFileName)
            Set cn = CreateObject("ADODB.Connection")
            Set rs = CreateObject("ADODB.Recordset")
            cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFileName(i) & _
                       ";Extended Properties=""Excel 8.0;HDR=No;"";"
            rs.Open "SELECT * " & _
                    "FROM [AOS$] " & _
                    "WHERE F2='" & Label1.Caption & "'", cn
            If rs.EOF Then
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                        "Khong thoa dieu kien.", vbOKOnly + vbCritical, "Tim kiem"
                rs.Close
            Else
                rs.Close
                rs.Open "SELECT * FROM [AOS$] ", cn
                rs.MoveFirst
                Do While Not rs.EOF
                    strKQ = strKQ & rs![F1] & " - " & rs![F2] & vbNewLine
                    rs.MoveNext
                Loop
                MsgBox "File trong duong dan: " & vbNewLine & strFileName(i) & vbNewLine & _
                       "Co ket qua nhu sau: " & vbNewLine & strKQ
                rs.Close
            End If
            Set rs = Nothing
            cn.Close:    Set cn = Nothing
        Next i
    End If
End Sub
Lưu ý: Khi nhấn nút test, hộp thoại mở ra, bạn nhấn giử phím ctrl+chọn bao nhiêu file tùy ý rồi nhấn Open nhé.
Nhấp chuột vào đây để mở rộng...


Bạn cho mình hỏi thêm là có cách nào tự động chọn tất cả các file trong Folder đó ko?(trong khi ta chỉ cần chọn 1 file). và có thể in tên các file đó vào 1 nơi bất kỳ nào đó.
Thanks!!!
 
Lần chỉnh sửa cuối:
Upvote 0
phungg đã viết:
Bạn cho mình hỏi thêm là có cách nào tự động chọn tất cả các file trong Folder đó ko? và có thể in tên các file đó vào 1 nơi bất kỳ nào đó.
Thanks!!!
Nhấp chuột vào đây để mở rộng...

Tôi chỉ có thể giúp bạn đến đây là việc lấy dữ liệu ở file đang đóng, còn bạn muốn thêm nữa thì bạn chờ người khác ngang qua giúp nhé.
 
Upvote 0
Gui Hai Lua

mình đã chạy thử và chọn tất cả các file và đã OK

Mình cảm ơn.
Bạn thật tuyệt!!!
 
Upvote 0
Bác cho em hỏi cách tìm từ bất kỳ trong cột "TEN BENH" được không ạ? Vì em thử nó chi tìm từ đầu tiên thôi không tìm từ có trong 1 chuỗi ký tự ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK) (4 người xem)
Trả lời
3
Đọc
24
ongke0711
ongke0711
P
GOAL SEEK NÂNG CAO TRONG EXCEL
    • Thích
Trả lời
4
Đọc
149
Hoale85
H
H
Đánh số thứ thự phiếu thu chi (2 người xem)
Trả lời
3
Đọc
52
LOGANWover
L
B
Gán Phím Tắt Gọi Form (1 người xem)
Trả lời
7
Đọc
60
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô
Trả lời
2
Đọc
104
LOGANWover
L
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau (1 người xem)
Trả lời
0
Đọc
26
Gà Công Nghệ
Gà Công Nghệ
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel
    • Thích
    • Yêu thích
Trả lời
11
Đọc
882
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian (1 người xem)
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô
Trả lời
12
Đọc
164
LINH7979
L
H
[Xin giúp đỡ] Tìm thời gian trùng ở nhiều khoảng thời gian khác nhau.
Trả lời
14
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
N
Thuế thu nhập cá nhân
    • Chấp nhận
Trả lời
3
Đọc
240
ngouyen1505
N
D
Lọc các ô có dữ liệu trùng nhau trong một cột. Xin chỉ giúp
Trả lời
7
Đọc
276
Gà Công Nghệ
Gà Công Nghệ
Gà Công Nghệ
Tự động điều chỉnh căn giãn dữ liệu theo độ rộng của ô trong excel
Trả lời
4
Đọc
112
Gà Công Nghệ
Gà Công Nghệ
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao
Trả lời
17
Đọc
563
Phan Thế Hiệp
Phan Thế Hiệp
bitun1991
Xin nhờ hỗ trợ làm file excel giải đấu bóng đá
Trả lời
1
Đọc
63
Duy Tùng 9x
Duy Tùng 9x
tuanlemanh
Chữ trong ô bị nhảy dòng khi in (1 người xem)
Trả lời
2
Đọc
56
tuanlemanh
tuanlemanh
tramcannt
các bác giúp em với ạ
Trả lời
0
Đọc
48
tramcannt
tramcannt
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL
Trả lời
7
Đọc
145
ptm0412
ptm0412
S
Tạo sheet mới từ dữ liệu 2 sheet khác ĐVT
Trả lời
0
Đọc
47
skmart
S
X
Làm thế nào để ẩn "Blank" trong Pivot table
    • Thích
Trả lời
14
Đọc
36K
hoangpham1105
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom