hỏi về code mở hộp thoại

[vanphamlb]

Tôi có file tonghop để import dữ liệu từ các file con . Tôi muốn khi chạy code thì đầu tiên phải xuất hiện hộp thoại để chọn các file cần lấy dữ liệu , rồi sau đó mới đến thi hành các lệnh khác ,.. Không biết phải thêm dòng lệnh nào vào đoạn code trong file tonghop sau đây (gởi kèm file) để thực hiện điều này . Xin nhờ anh em chỉ giúp , rất cảm ơn .

 

[ndu96081631]

Tôi có file tonghop để import dữ liệu từ các file con . Tôi muốn khi chạy code thì đầu tiên phải xuất hiện hộp thoại để chọn các file cần lấy dữ liệu , rồi sau đó mới đến thi hành các lệnh khác ,.. Không biết phải thêm dòng lệnh nào vào đoạn code trong file tonghop sau đây (gởi kèm file) để thực hiện điều này . Xin nhờ anh em chỉ giúp , rất cảm ơn .

Về hộp Open, bạn có thể dùng cái này:

Application.GetOpenFilename("Excel Files, *.xls;*xlsx;*.xlsm", , , , True)

Cho phép chọn nhiều file cùng lúc
Tuy nhiên xem file của bạn thì thấy rằng với cách tổng hợp trên, ta có thể dùng PivotTable mà không cần phải dùng bất cứ code nào

 

[vanphamlb]

Về hộp Open, bạn có thể dùng cái này:

Application.GetOpenFilename("Excel Files, *.xls;*xlsx;*.xlsm", , , , True)

Cho phép chọn nhiều file cùng lúc
Tuy nhiên xem file của bạn thì thấy rằng với cách tổng hợp trên, ta có thể dùng PivotTable mà không cần phải dùng bất cứ code nào

Xin cảm ơn anh ndu96081631 rất nhiều . Anh có thể giúp đưa phương thức GetOpen của anh vào đoạn code được không ? em đã làm nhưng không chạy được ( Vì kiến thức VBA của em còn rất mơ hồ , đoạn code này em sưu tầm trên diễn đàn có thêm bớt chút ít để phù hợp với công việc của mình ) . Chỉ còn vấn đề hộp thoại Open đưa vào đoạn code như thế nào để chọn các file lưu ở các thư mục tùy ý . Mong anh giúp đỡ , bản thân xem đây là cơ hội học hỏi tuyệt vời . Xin cảm ơn .

 

[ndu96081631]

Xin cảm ơn anh ndu96081631 rất nhiều . Anh có thể giúp đưa phương thức GetOpen của anh vào đoạn code được không ? em đã làm nhưng không chạy được ( Vì kiến thức VBA của em còn rất mơ hồ , đoạn code này em sưu tầm trên diễn đàn có thêm bớt chút ít để phù hợp với công việc của mình ) . Chỉ còn vấn đề hộp thoại Open đưa vào đoạn code như thế nào để chọn các file lưu ở các thư mục tùy ý . Mong anh giúp đỡ , bản thân xem đây là cơ hội học hỏi tuyệt vời . Xin cảm ơn .

Thôi thì bạn mô tả công việc cụ thể của code đi (tôi làm biếng xem code viết sẵn để suy đoán lắm)
Bạn muốn mở file con rồi copy vùng nào vào file TongHop?

 

[vanphamlb]

Xin cảm ơn anh . Ý em muốn chỉ lấy cột điểm số ở các file còn rồi đưa vào file tổng hợp (tương ứng với các tiêu đề cột) .

 

[ndu96081631]

Xin cảm ơn anh . Ý em muốn chỉ lấy cột điểm số ở các file còn rồi đưa vào file tổng hợp (tương ứng với các tiêu đề cột) .

Nếu tôi làm bài này thì sẽ làm hơi khác 1 chút
1> Code lấy dữ liệu từ file đang đóng (dùng ADO)

Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
  Dim tmpArr, arr()
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  lVer = Val(Application.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = arr
End Function

2> Code chính:

Sub Main()
  Dim vFile, Item, arr
  Dim lC As Long, wks As Worksheet, chk As Boolean
  Dim FileName As String, SheetName As String, RangeAddress As String
  vFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsm;*.xlsx", , , , True)
  If TypeName(vFile) = "Variant()" Then
    SheetName = "Sheet1"
    RangeAddress = "C1:C10000"
    Set wks = ThisWorkbook.Sheets("tonghop")
    wks.Range("C2:AA10000").ClearContents
    For Each Item In vFile
      FileName = CStr(Item)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        chk = True
        arr = GetData(FileName, SheetName, RangeAddress, True, True)
        wks.Range("C2").Offset(, lC).Resize(UBound(arr) + 1).Value = arr
        lC = lC + 1
      End If
    Next
    If chk Then MsgBox "Da hoan tat viec import so lieu diem cua: " & lC & " mon!"
  End If
End Sub

3> Cách dùng:
- Mở file, bấm nút để chạy code
- Hộp Open file hiện ra, ta dùng chuột chọn file đầu, giữ phím Shift rồi chọn file cuối
- Bấm Open và chờ..
-----------------
Xin lưu ý để bạn yên tâm rằng: Function GetData viết gì thây kệ nó, bạn không cần quan tâm, chỉ cần biết xài là được
Cú pháp hàm: GetData(Đường dẫn đến file, Tên Sheet, Địa chỉ vùng dữ liệu, Dữ liệu có tiêu đề hay không? Có lấy tiêu đề hay không?)
Cứ thế "ráp" vào code của ta mà xài