Gửi dữ liệu từ Excel vào mảng của VB (1 người xem)

[Tancowc]

Help: Gửi dữ liệu từ Excel vào mảng của VB

Xin chào,
Mình có vướng mắc nhờ cả nhà giúp với.
Chả là mình có đề tài thực hiện trên VB mà cần nhập nhiều biến cho 1 mảng. Mình không muốn làm dài chương trình VB nên nhờ các bác giúp mình các VB lấy mảng từ file Excel với. Mình gửi kèm theo bảng Excel cần import vào VB thành mảng.

Cảm ơn các bạn !

 

[maytinhvp01]

Xin chào,
Mình có vướng mắc nhờ cả nhà giúp với.
Chả là mình có đề tài thực hiện trên VB mà cần nhập nhiều biến cho 1 mảng. Mình không muốn làm dài chương trình VB nên nhờ các bác giúp mình các VB lấy mảng từ file Excel với. Mình gửi kèm theo bảng Excel cần import vào VB thành mảng.

Cảm ơn các bạn !

Câu hỏi của bạn chung chung quá!!!
"Bảng giá trị của Mảng cần đem vào trong chương trình VB" đưa vào đâu? listbox hay combobox hay datagrid ....
mà bạn đưa cái file cộc lố thế ai biết bạn muốn gì mà giúp. "chương trình VB của bạn dơn giản như thế nào gửi cả lên và nói rỗ cái bạn cần???"
-->>> may ra thì bạn có hồi âm!!

 

[Tancowc]

Thanks bạn,
Bạn làm sao dùng Project phía dưới lấy được dữ liệu từ file Excel mình gửi là mình cảm ơn lắm.

 

[dhn46]

Bạn dùng Code sau

Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim ExApp As Object
Dim ExWb As Object
Dim ExWs As Object
Dim Arr() As String


Set ExApp = CreateObject("Excel.Application")
Set ExWb = ExApp.Workbooks.Open("C:\Mang can dem vao VB.xls") 'Duong dan file Excel
Set ExWs = ExWb.Worksheets("Sheet1")
ReDim Arr(1 To ExWs.Range("A65536").End(3).Row, 1 To 2)


For i = 5 To ExWs.Range("A65536").End(3).Row
    For j = 1 To 2
        Arr(i - 4, j) = ExWs.Cells(i, j)
    Next
Next
End Sub

 

[nmhung49]

Bạn test thử code này

[GPECODE=vb]
Private Sub Command1_Click()
Dim mang() As String
Dim i As Long, j As Long, data, MyPath As String
Dim ExcelApp As Object, ExcelWorkbook As Object, ExcelSheet As Object
MyPath = App.Path
'Lay duong dan cua file excel
Set ExcelApp = CreateObject("Excel.Application")
'Mo Ung dung cua Excel
Set ExcelWorkbook = ExcelApp.Workbooks.Open(FileName:=MyPath & "\Mang can dem vao VB.xls")
'Mo Workbook muon lay du lieu
Set ExcelSheet = ExcelWorkbook.Sheets("Sheet1")
'Toi sheet muon lay du lieu
data = ExcelSheet.Range("A5:B18").Value
'Gan du lieu vao bien data de chuyen vao Mang

ReDim mang(1 To UBound(data), 1 To UBound(data, 2))
'Thay doi kich thuoc cua mang
For i = 1 To UBound(data)
For j = 1 To UBound(data, 2)
mang(i, j) = data(i, j) 'lay gia tri tu sheet dua vao mang
MsgBox mang(i, j)
Next
Next i
'Thoat khoi Excel
ExcelWorkbook.Close
ExcelApp.Quit
Set ExcelApp = Nothing
Set ExcelWorkbook = Nothing
Set ExcelSheet = Nothing

End Sub
[/GPECODE]
Code dnh46 nên đóng ứng dụng lại để giải phóng bộ nhớ

 

[siwtom]

Code dnh46 nên đóng ứng dụng lại để giải phóng bộ nhớ

Nếu VBA cũng làm như tôi đã từng nghĩ thì: các biến Object kia là "cục bộ". Trước khi ra khỏi Sub thì bộ nhớ sẽ được giải phóng - object sẽ bị "hủy". Cái này được làm sau "cánh gà".

Tất nhiên thói quen set = NOTHING là thói quen tốt.

 

[Hai Lúa Miền Tây]

Dùng ADO như sau nhé, khỏi mở file excel để lấy.

Private Sub Command1_Click()
Dim cn As Object, rst As Object
Dim mySQL As String
Dim mang As Variant
Dim r As Integer, c As Integer
Set cn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & App.Path & "\Mang can dem vao VB.xls;" & _
                        "Extended Properties=Excel 8.0;"
    .Open
End With
mySQL = "SELECT * FROM [Sheet1$A4:B100]" ' Dong du lieu den dong thu 100
Set rst = cn.Execute(mySQL)
mang = rst.GetRows
rst.Close: cn.Close
Set rst = Nothing: Set cn = Nothing
For r = LBound(mang, 2) To UBound(mang, 2)       'Duyet dong
  For c = LBound(mang, 1) To UBound(mang, 1)     'Duyet cot
    Debug.Print mang(c, r),
  Next
  Debug.Print vbCrLf
  Debug.Print "----------------------------"
Next
Erase mang

End Sub

 

[Tancowc]

Cảm ơn mọi người đã giúp đỡ.
Cho mình hỏi tại sao khi chạy Code này thì Text1 và Label1 lại Empty nhỉ ?

Option ExplicitPrivate Sub Command1_Click()
Dim objExcel As Object
Dim objWB As Object
Dim ExArray() As Variant


Set objExcel = CreateObject("excel.application")
Set objWB = objExcel.Workbooks.Open("C:\Array\array.xls")
ExArray() = objWB.Sheets("sheet1").Range("A1:A13").Value
ReDim ExArray(1 To UBound(ExArray))
'MsgBox ExArray()
Text1.Text = ExArray(4)
Label1.Caption = ExArray(5)
objWB.Close SaveChanges:=False
Set objWB = Nothing
'objWB.Close
objExcel.Quit
Set objExcel = Nothing
End Sub


Private Sub Command2_Click()
Unload Me
End Sub

 

[ndu96081631]

Cảm ơn mọi người đã giúp đỡ.
Cho mình hỏi tại sao khi chạy Code này thì Text1 và Label1 lại Empty nhỉ ?

Option Explicit
Private Sub Command1_Click()
Dim objExcel As Object
Dim objWB As Object
Dim ExArray() As Variant


Set objExcel = CreateObject("excel.application")
Set objWB = objExcel.Workbooks.Open("C:\Array\array.xls")
ExArray() = objWB.Sheets("sheet1").Range("A1:A13").Value
[COLOR=#ff0000]ReDim ExArray(1 To UBound(ExArray))[/COLOR]
'MsgBox ExArray()
Text1.Text = ExArray(4)
Label1.Caption = ExArray(5)
objWB.Close SaveChanges:=False
Set objWB = Nothing
'objWB.Close
objExcel.Quit
Set objExcel = Nothing
End Sub


Private Sub Command2_Click()
Unload Me
End Sub

Khỏi xem file cũng thấy code sai tè lè
Dòng màu đỏ khiến cho mảng ExArray bị Empty toàn bộ các phần tử (mà cũng không hiểu bạn ReDim để làm giống gì nữa)
Sửa lại:

Private Sub Command1_Click()
  Dim objExcel As Object, objWB As Object
  Dim ExArray As Variant
  Set objExcel = CreateObject("Excel.Application")
  Set objWB =objExcel.Workbooks.Open("C:\Array\array.xls")
  ExArray = objWB.Sheets("Sheet1").Range("A1:A13").Value
  Me.Text1.Text = [COLOR=#ff0000]ExArray(4, 1)[/COLOR]
  Me.Label1.Caption = [COLOR=#ff0000]ExArray(5, 1)[/COLOR]
  objWB.Close False
  Set objWB = Nothing
  objExcel.Quit
  Set objExcel = Nothing
End Sub

Lưu ý quan trọng: Mọi mảng được lấy từ bảng tính Excel đều mà MÀNG 2 CHIỀU

 

[Hai Lúa Miền Tây]

Dùng ADO sẽ cho tốc độ nhanh hơn

Private Sub Command3_Click()
    Dim cn As Object, rst As Object
    Dim mang As Variant
    Set cn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & App.Path & "\Array.xls;" & _
                            "Extended Properties=""Excel 8.0;HDR=No"";"
        .Open
    End With
    Set rst = cn.Execute("SELECT * FROM [Sheet1$A1:A100]")
    mang = rst.GetRows
    rst.Close: cn.Close
    Set rst = Nothing: Set cn = Nothing
    Me.Text1.Text = mang(0, 1)
    Me.Label1.Caption = mang(0, 2)
    Erase mang
    
End Sub

 

[ndu96081631]

Dùng ADO sẽ cho tốc độ nhanh hơn

Hình như phải tính cái vụ liên quan đến version chứ nhỉ?

 

[Hai Lúa Miền Tây]

Hình như phải tính cái vụ liên quan đến version chứ nhỉ?

Với file mẫu là Excel 2003 thì không cần phải tính đến version Thầy à.