Bài tập về ADO căn bản. (1 người xem)

[Kiều Mạnh]

Như bác batman1 nói tập tin có định dạng UTF-8 (từ web) nên bạn Mạnh chỉ có thể dùng ADODB. Stream để đọc và ghi nó được thôi. ADODB Stream có thể đọc tên file có dấu chấm than (!) luôn nhé.
Ví dụ:

sFilePath = ThisWorkbook.Path & "\SIM BANKING!.CSV"
Dim oStream As Object
   Set oStream = CreateObject("ADODB.Stream")
   With oStream
        .Open
        .Type = 1  ' adTypeBinary
        .LoadFromFile sFilePath
        .Type = 2  ' adTypeText
        .Charset = "utf-8"
        strText = .ReadText(-1)  ' adReadAll
    End With
    ...
    'Code đưa strText vào Sheet'

mạnh mới thử code này trên Google thấy chạy Ok

Sub GetCSV()
    Dim strText As String, intRow
    Dim file As String, strLine
    file = "E:\Downloads\VBA_ADO_CSV\SIM BANKING!.csv"
    With CreateObject("ADODB.Stream")
         .Open
         .Type = 1                  ' Private Const adTypeBinary = 1
         .LoadFromFile file
         .Type = 2                  ' Private Const adTypeText = 2
         .Charset = "utf-8"
         strText = .ReadText(-1)    ' Private Const adReadAll = -1
     End With
    intRow = 1
    Cells.Clear
    For Each strLine In Split(strText, Chr(10))
        If strLine <> "" Then
            With Sheet1
                .Cells(intRow, 1) = strLine
                .Cells(intRow, 1).TextToColumns Destination:=Cells(intRow, 1), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                    Semicolon:=False, Comma:=True, Space:=False, Other:=False
            End With
            intRow = intRow + 1
        End If
    Next strLine
End Sub

Tuy nhiên mạnh muốn tách cái khúc For Each đó thành một cái hàm riêng và chạy trên Mảng mà chưa hiểu lắm .... nếu Bạn Or thành viên nào biết chỉ dùm !!???

 

[Kiều Mạnh]

Mò diết cuối cùng cũng xong .... rồi ngộ ra 1 vài điều hay ... Nếu ngồi đó ko Mò thì sẻ không bao giờ thấy cái hay và thú vị của nó
Quả thực ko leo núi mà cứ keo núi cao thì đó là 1 cái chi chi đó
Cảm ơn Các Bạn !

 

[syquyen1987]

1. Hàm GetRows() của RecordSet lấy dữ liệu vào mảng. Nếu không có tham số thì nó đổ cả RecordSet vào 1 mảng 2 chiều. Từ đó, mò đến dòng cuối cùng của mảng.
2. Hàm MoveLast đi đến dòng cuối của RecordSet. Hàm GetRows(1, 0) đọc dòng này
Thực ra thì GetRows(1, 2) cũng đọc được dòng cuối của RecordSet mà không cần MoveLast.

Anh ơi, có một nhược điểm là dòng database đang là ngang, khi đổ dữ liệu xuống sheeet lại thành dọc. Em dùng Application.WorksheetFunction.Transpose thì báo lỗi ạ. Có cách nào đổ dữ liệu xuống sheet đúng dạng ngang như Database không ạ. Em cảm ơn

 

[VetMini]

Hàm transpose của Excel có rất nhiều giới hạn, chỉ có thể dùng trong các CSDL nhỏ.
Tôi nhớ không lầm thì Recordset vốn lấy từ DAO, công cụ cũ của Access. Nên nhớ rằng kỹ thuật CSDL LH (relational database) không hẳn phù hợp với cấu trúc chuyên về bộ nhớ và tốc độ của Array.
Muón đổ xuống. tôi nghĩ là bạn nên tìm cách chuyển dữ liệu từ Recordset sang Array.

 

[syquyen1987]

Hàm transpose của Excel có rất nhiều giới hạn, chỉ có thể dùng trong các CSDL nhỏ.
Tôi nhớ không lầm thì Recordset vốn lấy từ DAO, công cụ cũ của Access. Nên nhớ rằng kỹ thuật CSDL LH (relational database) không hẳn phù hợp với cấu trúc chuyên về bộ nhớ và tốc độ của Array.
Muón đổ xuống. tôi nghĩ là bạn nên tìm cách chuyển dữ liệu từ Recordset sang Array.

Vâng, em hiểu rồi. Vẫn cần phải có mảng trung gian để chuyển đổi. Em cảm ơn ạ

 

[Kiều Mạnh]

1/ duyệt từng Recordset tới đâu tính toán tới đó sẻ rất nhanh hơn mục số 2
2/ lấy vào Arr = Rs.GetRows xong chạy 2 vòng For rất chậm

 

[thnghiachau]

Anh ơi, có một nhược điểm là dòng database đang là ngang, khi đổ dữ liệu xuống sheeet lại thành dọc. Em dùng Application.WorksheetFunction.Transpose thì báo lỗi ạ. Có cách nào đổ dữ liệu xuống sheet đúng dạng ngang như Database không ạ. Em cảm ơn

bạn có thể sử dụng hàm này

Function TransposeArray2D(arr2D As Variant) As Variant
Dim X As Long, Y As Long
Dim arrTemp As Variant
    ReDim arrTemp(LBound(arr2D, 2) To UBound(arr2D, 2) - LBound(arr2D, 2) + 1, LBound(arr2D, 1) To UBound(arr2D, 1) - LBound(arr2D, 1) + 1)
    For X = LBound(arr2D, 2) To UBound(arr2D, 2)
        For Y = LBound(arr2D, 1) To UBound(arr2D, 1)
            arrTemp(X, Y) = arr2D(Y, X)
        Next Y
    Next X
    TransposeArray2D = arrTemp
End Function

để chuyển dữ liệu lấy bằng ADO về đúng như dạng gốc trong Database: TransposeArray2D(objRecordSet.GetRows)

 

[Kiều Mạnh]

bạn có thể sử dụng hàm này

Function TransposeArray2D(arr2D As Variant) As Variant
Dim X As Long, Y As Long
Dim arrTemp As Variant
    ReDim arrTemp(UBound(arr2D, 2), UBound(arr2D, 1))
    For X = LBound(arr2D, 2) To UBound(arr2D, 2)
        For Y = LBound(arr2D, 1) To UBound(arr2D, 1)
            arrTemp(X, Y) = arr2D(Y, X)
        Next Y
    Next X
    TransposeArray2D = arrTemp
End Function

để chuyển dữ liệu lấy bằng ADO về đúng như dạng gốc trong Database: TransposeArray2D(objRecordSet.GetRows)

Bạn hãy thử kiểu nhà quê vầy xem sao nha
dùng hàm của Bạn Copy từ vùng màu xanh gán sang vùng màu vàng .... Xong làm ngược lại Copy vùng màu vàng gán qua màu xanh xem sao ???
nếu dữ liệu nằm trong Vùng vừa khít trong vùng vừa gán đó thì nên xài hàm đó ... còn nếu nó xóa mất cái chữ kk thì nên Viết lại cho đúng he



Thông cảm mình ko có được học hành code két bài vở nên toàn chơi kiểu nhà quê vậy

 

[thnghiachau]

Bạn hãy thử kiểu nhà quê vầy xem sao nha
dùng hàm của Bạn Copy từ vùng màu xanh gán sang vùng màu vàng .... Xong làm ngược lại Copy vùng màu vàng gán qua màu xanh xem sao ???
nếu dữ liệu nằm trong Vùng vừa khít trong vùng vừa gán đó thì nên xài hàm đó ... còn nếu nó xóa mất cái chữ kk thì nên Viết lại cho đúng he

View attachment 245660

Thông cảm mình ko có được học hành code két bài vở nên toàn chơi kiểu nhà quê vậy

Cám ơn anh @Kiều Mạnh nhiều, nhờ anh chỉ điểm em mới phát hiện ra!
Lâu nay cái này em chỉ làm cho cái dzụ lấy dữ liệu từ ADO thôi nên không để ý về LBound đi từ 0 hay đi từ 1.
em chỉnh lại:

Function TransposeArray2D(arr2D As Variant) As Variant
Dim X As Long, Y As Long
Dim arrTemp As Variant
    ReDim arrTemp(LBound(arr2D, 2) To UBound(arr2D, 2) - LBound(arr2D, 2) + 1, LBound(arr2D, 1) To UBound(arr2D, 1) - LBound(arr2D, 1) + 1)
    For X = LBound(arr2D, 2) To UBound(arr2D, 2)
        For Y = LBound(arr2D, 1) To UBound(arr2D, 1)
            arrTemp(X, Y) = arr2D(Y, X)
        Next Y
    Next X
    TransposeArray2D = arrTemp
End Function

Không biết còn sai sót gì không nữa... hichic

 

[Kiều Mạnh]

Còn đây là chuẩn của Bill ... không tin thử quậy là biết
Copy qua xong Copy lại xem sao ????????????????????

 

[Kiều Mạnh]

Cám ơn anh @Kiều Mạnh nhiều, nhờ anh chỉ điểm em mới phát hiện ra!
Lâu nay cái này em chỉ làm cho cái dzụ lấy dữ liệu từ ADO thôi nên không để ý về LBound đi từ 0 hay đi từ 1.
em chỉnh lại:

Function TransposeArray2D(arr2D As Variant) As Variant
Dim X As Long, Y As Long
Dim arrTemp As Variant
    ReDim arrTemp(1 To UBound(arr2D, 2) - LBound(arr2D, 2) + 1, 1 To UBound(arr2D, 1) - LBound(arr2D, 1) + 1)
    For X = LBound(arr2D, 2) To UBound(arr2D, 2)
        For Y = LBound(arr2D, 1) To UBound(arr2D, 1)
            arrTemp(X, Y) = arr2D(Y, X)
        Next Y
    Next X
    TransposeArray2D = arrTemp
End Function

Không biết còn sai sót gì không nữa... hichic

Trên GPE này họ ít khi để ý mấy thứ vặt vảnh đó nên hầu như sai tè le ra hình như có cái hàm của Anh có chữ cái là n là chính xác
Tuy nhiên cách chạy 2 vòng For và Viết thành Function đó chạy hơi chậm ... thử viết lại thành Sub xem tình hình sao ???

 

[thnghiachau]

thử viết lại thành Sub xem tình hình sao ???

Em chưa hiểu ý anh lắm ạ,

 

[Kiều Mạnh]

Em chưa hiểu ý anh lắm ạ,

1/ Viết thành Function bạn làm xong rồi
2/ Thử viết thành Sub xem sao như hàm đó nhưng truyền Tham số vào
VD Như sau:

Private Sub Transpose_Array(ByRef InputArr() As Variant, ByRef ReturnArray() As Variant)

3/ xong thử cột sang dòng và ngược lại
4/ Thử chuyển cái Array khoãng trên 1 triệu dòng xem sao ( Lưu ý không tràn số cột của Excel Or dòng ... nếu quá là lỗi code )
5/ đo tốc độ chạy code xem sao ????

Cao cấp chút nè
1/ dùng hàm API của Bill CopyMemory cái Array ban đầu vào bộ nhớ RAM
2/ xong chuyển Array lấy nó ra gán lại Sheet

2 mục trên đó khoãng gần 10 năm trước đã có chiến sự trên GPE rồi mà các thành viên đó hàng ngày vẫn cứ lang thang đâu đó
nếu thích vào đó đào lại xem tình hình sao ?????????????????!!!!!!!!!!!!!!!!!!!!!!!!!

 

[befaint]

Private Sub Transpose_Array(ByRef InputArr() As Variant, ByRef ReturnArray() As Variant)

InputArr thì ByVal chứ anh.

tràn số cột của Excel Or dòng ... nếu quá là lỗi code

Vụ này nói rồi mà anh. Kích thước Array không liên quan gì kích thước bảng tính.

 

[Kiều Mạnh]

InputArr thì ByVal chứ anh.

Vụ này nói rồi mà anh. Kích thước Array không liên quan gì kích thước bảng tính.

cái tô đậm đó biết mà .... nhưng khi chuyển mảng nó tràn số dòng gán xuống Sheet thì sao đây ???!!!
VD: Excel 2010 to 2019 có 1048576 dòng mà cái Array đó có tỷ tỷ dòng thì sao ??? ===> lỗi chứ còn gì ???

 

[befaint]

cái tô đậm đó biết mà .... nhưng khi chuyển mảng nó tràn số dòng gán xuống Sheet thì sao đây ???!!!
VD: Excel 2010 to 2019 có 1048576 dòng mà cái Array đó có tỷ tỷ dòng thì sao ??? ===> lỗi chứ còn gì ???

Híc. Anh lại máy móc rồi. Anh chưa gặp bài chuyển thành nhiều cột, hết cột chuyển tiếp sang sheet(s) khác...

 

[Kiều Mạnh]

Híc. Anh lại máy móc rồi. Anh chưa gặp bài chuyển thành nhiều cột, hết cột chuyển tiếp sang sheet(s) khác...

thì đó là sự thật mà Nếu cái Array gán xuống Sheet mà lớn hơn số dòng Or cột của Excel hiện có thì lỗi chắc luôn chứ gì ???!!!
Còn kích thước của Array phụ thuộc vào RAM To hay Nhỏ trên GPE nay nói rồi ( ko nói lại nữa )

 

[befaint]

thì đó là sự thật mà Nếu cái Array gán xuống Sheet mà lớn hơn số dòng Or cột của Excel hiện có thì lỗi chắc luôn chứ gì ???!!!

Có lỗi gì đâu anh. Khi Range < kích thước Array thì Range có bao nhiêu cells nhận bấy nhiêu phần tử từ Array thôi.

Option Explicit

Sub vidu()
    Const nums = 2000000
    Dim a As Variant, i As Long
    ReDim a(1 To nums, 1 To 1)
    For i = 1 To nums
        a(i, 1) = i
    Next i
    Sheet1.Range("A1:A1048576").Value = a
End Sub

 

[Kiều Mạnh]

Có lỗi gì đâu anh. Khi Range < kích thước Array thì Range có bao nhiêu cells nhận bấy nhiêu phần tử từ Array thôi.

Option Explicit

Sub vidu()
    Const nums = 2000000
    Dim a As Variant, i As Long
    ReDim a(1 To nums, 1 To 1)
    For i = 1 To nums
        a(i, 1) = i
    Next i
    Sheet1.Range("A1:A1048576").Value = a
End Sub

Biết mà ............ Nhưng VD họ lấy cái Array đó từ Sever về có số dòng lớn hơn số dòng hiện có của bảng tính thì sao đây ... hay TableName Access
ý Mạnh nói cái đó đấy ... hay lấy nguyên cột = 1048576 xong chuyển gán qua dòng là thấy vì số dòng lớn hơn số cột mà

 

[befaint]

Biết mà ............ Nhưng VD họ lấy cái Array đó từ Sever về có số dòng lớn hơn số dòng hiện có của bảng tính thì sao đây ... hay TableName Access
ý Mạnh nói cái đó đấy ... hay lấy nguyên cột = 1048576 xong chuyển gán qua dòng là thấy vì số cột lớn hơn số dòng mà

Ở trên em nói rồi đó anh.
Tức là nếu xác định, hoặc nghi ngờ từ đầu, kết quả trả về lớn hơn kích thước chứa kết quả đó thì mình chia nhỏ ra ngay lúc xử lý (có thể tách luôn thành nhiều cột, hoặc tách thành nhiều mảng)..