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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ (3 người xem)
Trả lời
4
Đọc
40
HeSanbi
HeSanbi
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước. (2 người xem)
Trả lời
3
Đọc
68
hanhnguyen12022021
H
V
  • Question Question
Đếm xếp loại của đơn hàng (3 người xem)
Trả lời
4
Đọc
64
Hoàng Tuấn 868
H
N
Không chạy được file VBA (1 người xem)
Trả lời
2
Đọc
78
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến (2 người xem)
9 10 11
Trả lời
214
Đọc
158K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
71
VetMini
V
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
65
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
110
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
170
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
144
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
302
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (2 người xem)
Trả lời
0
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng (2 người xem)
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect (1 người xem)
Trả lời
18
Đọc
268
HeSanbi
HeSanbi
NguyenNgocThuHien
  • Question Question
Liệt kê tổ hợp chập k của nhóm n phần tử.
    • Thích
    • Yêu thích
2 3
Trả lời
54
Đọc
17K
phương Đức
P
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
109
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
193
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
150
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
48
thuytrangbp28
T
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ
Trả lời
3
Đọc
94
hoangtuaotrang_hp_vn
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom