Định dạng ngày tháng năm (1 người xem)

[ndu96081631]

Giải pháp là sửa 1 chút như sau, là được (Bạn là người đã biết VBA , vậy để bạn so sánh ra sự thay đổi nhé , dễ nhìn thấy ngay mà và test lại dùm cùng nhận xét)

Function GetData(ByVal FileName As String, _
                 Optional ByVal SheetName As String = "", _
                 Optional ByVal RangeAddress As String = "", _
                 Optional ByVal HasHDR As Boolean = True)
            
  '................................
 [COLOR=#ff0000] For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      arr(lR, lC) = tmpArr(lC, lR)
    Next
  Next[/COLOR]
  '...................................
End Function

Chỗ màu đỏ hình như là còn thiếu đoạn lấy tiêu đề thì phải?
Tôi nghĩ là phải sửa thành:

Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim cnn As Object, rsData As Object
  Dim tmpArr, Arr
  Dim szConn As String, szSQL As String, tmp As String
  Dim lR As Long, lC As Long, lVersn As Long
  On Error GoTo ErrHandler
  lVersn = Val(Application.Version)
  Set cnn = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  
  If lVersn < 12 Then
    szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & ";IMEX=1"";"
  Else
    szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & ";IMEX=1"";"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, "''", "'")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  Else
    SheetName = SheetName & "$"
  End If
  cnn.Open szConn
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, cnn, 1, 1
  tmpArr = rsData.GetRows
  ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1))
  [COLOR=#ff0000]If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      Arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  rsData.Close: cnn.Close
  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[/COLOR]
  GetData = Arr
  Set rsData = Nothing: Set cnn = Nothing
  Exit Function
ErrHandler:
  MsgBox Err.Description
  Set rsData = Nothing: Set cnn = Nothing
End Function

Tóm lại:
- Xác định dữ liệu là có tiêu đề hay không (đối số HasTitle)
- Quyết định có lấy tiêu đề hay không khi dữ liệu có tiêu đề (đối số UseTitle)
-------------------
Sub Main ta viết lại như sau:

Sub Main()
  Dim FileName As String, SheetName As String, RangeAddress As String
  Dim Arr
  FileName = "D:\hoi GPE\123.xlsx"
  Arr = GetData(FileName, SheetName, RangeAddress, [COLOR=#ff0000]True, True[/COLOR])
  If IsArray(Arr) Then
    ThisWorkbook.Sheets("123").Range("A1").Resize(UBound(Arr, 1) + 1, _
    UBound(Arr, 2) + 1).Value = Arr
  End If
End Sub

Vầy chắc là ổn nhỉ?

 

[Cá ngừ F1]

Như vầy là quá nhanh quá tuyệt rồi ạh...
hơi sai CT 1 tí. Ẹc ẹc
cảm ơn thầy NDU, cảm ơn a vodoi2x