Lập trình để lấy giữ liệu từ file excel có tên file thay đổi (1 người xem)

  • Thread starter Thread starter Sunstar
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Sunstar

Thành viên mới
Tham gia
5/4/11
Bài viết
23
Được thích
3
Mình có 2 file excel lần lượt là A.xlsx và X.xlsx.
Tại file A.xlsx mình cần lấy dữ liệu ở file x.xlsx (với điều kiện ko cần mở file X.xlsx). Trong đó file X với tên file sẽ được thay đổi theo giá trị tháng.
Nhờ các bạn giúp mình file Macro với. Thank you nhiều :D

P/s: nếu như theo công thức hiện tại trong file A.xlsx đính kèm, thì 12 tháng có tương 12 file X.xlsx (lần lượt là 1.xlsx, 2.xlsx, ... ,12.xlsx) thì mình phải thay đổi lại công thức tại tất cả các ô trong file A.xlsx mỗi khi muốn lấy dữ liệu tháng nào đó; có cách nào đỡ thủ công hơn không ạ?
 

File đính kèm

Vâng đây là code cho bạn
Mã:
1            |             2             |              3            |                4                 |                  5

// Lên GPE, hồi nào học được cách trình bày bài viết cho hoàn chỉnh đi rồi ắc có người giúp. Không phải đính kèm file sơ sài như vậy là ngồi chờ sung nó rụng...

Vì mình không rành về Macro và ý tưởng giải quyết vấn đề của mình cũng chỉ ở mức sơ sài như vậy :( mình đâu phải là chờ sung rụng? Mình cần code cơ bản sau đó mình sẽ tự thân vận động áp dụng chứ ko phải kẻ thụ động đưa cả bài toán lớn lên rồi ngồi chờ sung rụng.

P/s: @hpkhuong : Không phải lúc nào cũng đánh giá người khác chỉ qua cách nhìn và cảm nhận đâu bạn. Nếu bạn không giúp bạn có thể lơ bài mình, vì bạn nói kiểu đó mình mới nói thẳng là bạn chẳng có tư cách gì đánh giá mình cả. Và tặng riêng bạn bài này nhé http://tinhhoa.net/nu-giam-doc-mat-viec-chi-boi-mot-cau-noi-cua-ong-lao-quet-rac.html
 
Upvote 0
Mình có 2 file excel lần lượt là A.xlsx và X.xlsx.
Tại file A.xlsx mình cần lấy dữ liệu ở file x.xlsx (với điều kiện ko cần mở file X.xlsx). Trong đó file X với tên file sẽ được thay đổi theo giá trị tháng.
Nhờ các bạn giúp mình file Macro với. Thank you nhiều :D

P/s: nếu như theo công thức hiện tại trong file A.xlsx đính kèm, thì 12 tháng có tương 12 file X.xlsx (lần lượt là 1.xlsx, 2.xlsx, ... ,12.xlsx) thì mình phải thay đổi lại công thức tại tất cả các ô trong file A.xlsx mỗi khi muốn lấy dữ liệu tháng nào đó; có cách nào đỡ thủ công hơn không ạ?

Đây là dạng bài "cơ bản" : lấy dữ liệu từ file đang đóng, giải pháp của mình như sau:
1. tìm hiểu vba, ado, chịu khó copy những hàm đã đã có trên diễn đàn !
2, mở file A.xlsx, copy hàm getdata ( 'tác giả Ndu...xxx...) , chuyển tên file thành A.xlsm
3. tùy biến theo mục đích của bạn
Mã:
'==Getdata function copyright NDU96081631
'---------------------------------------------
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

Mã:
Sub Button1_Click()
 Dim arr
  'On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\21 Thg6 17.xlsx", "Sheet1", "", False, False)
  If IsArray(arr) Then Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub


* Tham khảo file đính kèm, (lưu ý 2 file phải để cùng 1 folder)
 

File đính kèm

Upvote 0
.........Không phải lúc nào cũng đánh giá người khác chỉ qua cách nhìn và cảm nhận đâu bạn. .......
Bạn không nên đánh giá người khác kiểu trên, mà phải tự suy nghĩ lại, tại sao người ta muốn giúp mình mà chưa giúp được? có thể mấy vấn đề sau:

- Đính kèm File ít nhất cũng có tiêu đề và 1 ít dữ liệu để người giúp còn hiểu bạn muốn làm cái gì tiếp theo mà còn góp ý (chứ không lẽ lấy dữ liệu vào để xem chơi), nhưng File không có dữ liệu thì lấy cái gì?

- Đã tham gia diễn đàn thì phải chấp nhận sự góp ý của người khác, chứ đừng nêu như vầy "bạn không giúp thì sẽ có người khác giúp", hoặc nêu vầy "bạn chẳng có tư cách gì đánh giá mình cả", người giúp muốn bạn rõ ràng hơn chứ chẳng ai trách móc bạn cả.

Tôi chỉ góp ý chung để các` thành viên cùng hòa thuận, vui vẽ, nhiệt tình giúp đỡ lẫn nhau (chứ không nên có những lời lẽ không hay ho chút nào) sẽ làm mất hòa khi của diễn đàn.

Nội quy diễn đàn có câu thế này: Thành viên tham gia thảo luận cần tôn trọng những người cùng tham gia không được khích bác, công kích, lăng mạ xúc phạm người khác, nóng nẩy, quá khích, gây mất đoàn kết trên diễn đàn.
 
Upvote 0
Đây là dạng bài "cơ bản" : lấy dữ liệu từ file đang đóng, giải pháp của mình như sau:
1. tìm hiểu vba, ado, chịu khó copy những hàm đã đã có trên diễn đàn !
2, mở file A.xlsx, copy hàm getdata ( 'tác giả Ndu...xxx...) , chuyển tên file thành A.xlsm
3. tùy biến theo mục đích của bạn
Mã:
'==Getdata function copyright NDU96081631
'---------------------------------------------
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

Mã:
Sub Button1_Click()
 Dim arr
  'On Error Resume Next
  arr = GetData(ThisWorkbook.Path & "\21 Thg6 17.xlsx", "Sheet1", "", False, False)
  If IsArray(arr) Then Range("A1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr
End Sub


* Tham khảo file đính kèm, (lưu ý 2 file phải để cùng 1 folder)

THANK BÁC NHÉ :D ĐỒNG NGHIỆP RỒI. MÌNH Ở EVNPTC ^^
 
Upvote 0
Bạn không nên đánh giá người khác kiểu trên, mà phải tự suy nghĩ lại, tại sao người ta muốn giúp mình mà chưa giúp được? có thể mấy vấn đề sau:

- Đính kèm File ít nhất cũng có tiêu đề và 1 ít dữ liệu để người giúp còn hiểu bạn muốn làm cái gì tiếp theo mà còn góp ý (chứ không lẽ lấy dữ liệu vào để xem chơi), nhưng File không có dữ liệu thì lấy cái gì?

- Đã tham gia diễn đàn thì phải chấp nhận sự góp ý của người khác, chứ đừng nêu như vầy "bạn không giúp thì sẽ có người khác giúp", hoặc nêu vầy "bạn chẳng có tư cách gì đánh giá mình cả", người giúp muốn bạn rõ ràng hơn chứ chẳng ai trách móc bạn cả.

Tôi chỉ góp ý chung để các` thành viên cùng hòa thuận, vui vẽ, nhiệt tình giúp đỡ lẫn nhau (chứ không nên có những lời lẽ không hay ho chút nào) sẽ làm mất hòa khi của diễn đàn.

Nội quy diễn đàn có câu thế này: Thành viên tham gia thảo luận cần tôn trọng những người cùng tham gia không được khích bác, công kích, lăng mạ xúc phạm người khác, nóng nẩy, quá khích, gây mất đoàn kết trên diễn đàn.

Mình là thành viên mới. OK không bàn cãi. Nếu bạn đã nói nội quy thì bạn so sánh Reply của mình và @hpkhuong xem ai là người công kích ai hơn?
+ Tiêu đề mình cũng có, diễn giải nội dung cũng có, file đính kèm cũng có. Tuy nó sơ sài nhưng mình cũng chỉ diễn đạt được có như vậy. Nếu chưa hiểu thì chỉ cần nói đơn giản là "mình chưa hiểu ý bạn", hoặc lơ bài mình đi ... chứ mình chả nói "bạn không giúp thì sẽ có người khác giúp".
+ "- Đã tham gia diễn đàn thì phải chấp nhận sự góp ý của người khác" thì cái reply của mình cũng chỉ là góp ý cho @hpkhuong theo ý kiến cá nhân.

Nói thế thôi, cũng chẳng muốn lạm bàn và mất thời gian vì mấy cái vấn đề lạc đề này . Mục đích của mình lên đây để học hỏi chứ ko phải để "tranh luận". Cảm ơn bạn đã đọc.
 
Upvote 0
Mình là thành viên mới. OK không bàn cãi. Nếu bạn đã nói nội quy thì bạn so sánh Reply của mình và @hpkhuong xem ai là người công kích ai hơn?
+ Tiêu đề mình cũng có, diễn giải nội dung cũng có, file đính kèm cũng có. Tuy nó sơ sài nhưng mình cũng chỉ diễn đạt được có như vậy. Nếu chưa hiểu thì chỉ cần nói đơn giản là "mình chưa hiểu ý bạn", hoặc lơ bài mình đi ... chứ mình chả nói "bạn không giúp thì sẽ có người khác giúp".
+ "- Đã tham gia diễn đàn thì phải chấp nhận sự góp ý của người khác" thì cái reply của mình cũng chỉ là góp ý cho @hpkhuong theo ý kiến cá nhân.

Nói thế thôi, cũng chẳng muốn lạm bàn và mất thời gian vì mấy cái vấn đề lạc đề này . Mục đích của mình lên đây để học hỏi chứ ko phải để "tranh luận". Cảm ơn bạn đã đọc.
Thầy hpkhuong có tuổi rồi phản ứng vậy cũng có cái lý. Mà trẻ nói mà già cứa oa oa vậy là sao
Quên em nói lộn :p
 
Upvote 0
// Lên GPE, hồi nào học được cách trình bày bài viết cho hoàn chỉnh đi rồi ắc có người giúp. Không phải đính kèm file sơ sài như vậy là ngồi chờ sung nó rụng...

Rất tiếc ở diễn đàn này nhiều "sung" lắm. Mọi thành viên đều biết rằng cứ chờ thì sung sẽ rụng.

Chú thích: từ "sung" trong dấu nháy ở trên dùng cho tĩnh tự chứ khong phải danh tự.

Thầy hpkhuong có tuổi rồi phản ứng vậy cũng có cái lý. Mà trẻ nói mà già cứa oa oa vậy là sao
Quên em nói lộn :p

Thế "em" có tuổi hay còn oa oa?

Chú thích: tôi mà gặp mấy kẻ nói chuyện nửa tây nửa ta còn lên tiếng đời "giỏi cái này cái khác" thì tôi mắng cho tới tấp. Không sợ hố, bởi vì có cái nguyên tắc rằng mình chưa hẳn giỏi nhất, nhưng những kẻ giỏi hơn mình họ nói chuyện rõ rệt lắm, nói một tiếng nhìn ra ngay.
 
Upvote 0
Em còn mới tập oa oa thôi thầy ạ. Mà em nõi thật trên GPE nhờ các thầy góp ý bọn em học được nhiều cái ( từ kiến thức lẫn cư xử...) và hoàn thiện hơn.
Em thích những bài thầy "mắng" trên diễn đàn. Vì trong đó toàn là kiến thức những lý thuyết căn bản mà em không bao giờ biết .... :D
 
Upvote 0
Có gì đó sai sai ...! ;
Mình đến diễn đàn GPE cũng lâu rồi, quan điểm của mình là : hỏi -đáp, chia sẻ - giúp đỡ;... cho đi bao nhiêu, nhận lại bấy nhiêu thế thôi;
Mọi vấn đề khác nếu muốn tồn tại lâu dài ở xã hội GPE này thì người trong cuộc tự hiểu, tự điều chỉnh sao cho phù hợp, đúng mực !
 
Upvote 0
Có gì đó sai sai ...! ;
Mình đến diễn đàn GPE cũng lâu rồi, quan điểm của mình là : hỏi -đáp, chia sẻ - giúp đỡ;... cho đi bao nhiêu, nhận lại bấy nhiêu thế thôi;
Mọi vấn đề khác nếu muốn tồn tại lâu dài ở xã hội GPE này thì người trong cuộc tự hiểu, tự điều chỉnh sao cho phù hợp, đúng mực !

{ cho đi bao nhiêu, nhận lại bấy nhiêu thế thôi } nếu đã quan niệm thế thì cứ yên tâm mà cho mà nhận, cần gì phải nói chuyện "sai sai"?

{ muốn tồn tại lâu dài ở xã hội GPE này... } chuyện tồn tại lâu dài không hẳn là do mình. Ngày tôi vào đây cũng có một vài tay chuyên nghiệp khác (không kể người trong BQT), nhưng hiện giờ chỉ còn mình tôi. Kỹ thuật "tự điều chỉnh" của tôi như thế đã là đáng tự hào rồi.
 
Upvote 0
Web KT

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

Back
Top Bottom