Giúp em sửa code copy dữ liệu và paste transpose

[alonelove]

Chào Anh/Chị ạ

Em có đoạn code tổng hợp số liệu từ nhiều file khác, tất cả file nguồn vùng (D1828) và định dạng text, file đích MAIN.xlsx copy giá trị vùng trên và nối liên tục vào 01 cột sheet("ketqua") định dạng number.
Giờ em muốn:
1. File đích MAIN.xlsx được dán dữ liệu từ Cột thành dòng như sheet("ketquamongmuon")
2. Code cũ lấy giá trị định dạng text dán sang định dạng number tuy nhiên không lấy giá trị sau dấu thập phân nên bị lệch số, giúp em lấy luôn giá trị phần thập phân ạ. Ví dụ file nguồn có text=4200,6 thì sang file MAIN chỉ lấy number 4.200 => mất phần thập phân 0,6

Em đính kèm file MAIN và 3 file nguồn Anh/Chị dễ hình dung ạ.
Em xin cảm ơn trước.

 

[giaiphap]

Chào Anh/Chị ạ

Em có đoạn code tổng hợp số liệu từ nhiều file khác, tất cả file nguồn vùng (D1828) và định dạng text, file đích MAIN.xlsx copy giá trị vùng trên và nối liên tục vào 01 cột sheet("ketqua") định dạng number.
Giờ em muốn:
1. File đích MAIN.xlsx được dán dữ liệu từ Cột thành dòng như sheet("ketquamongmuon")
2. Code cũ lấy giá trị định dạng text dán sang định dạng number tuy nhiên không lấy giá trị sau dấu thập phân nên bị lệch số, giúp em lấy luôn giá trị phần thập phân ạ. Ví dụ file nguồn có text=4200,6 thì sang file MAIN chỉ lấy number 4.200 => mất phần thập phân 0,6

Em đính kèm file MAIN và 3 file nguồn Anh/Chị dễ hình dung ạ.
Em xin cảm ơn trước.

Bạn dùng thử code này nhé.

Public Sub DATA_2774()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim i As Byte, lr As Long, s As String
Dim Wb As Workbook, aWb As Workbook, Arr
Set aWb = ThisWorkbook
aWb.Sheets("ketqua").Range("A1").CurrentRegion.Offset(1).ClearContents
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "2774", "*.xl*"
        .InitialFileName = "nguon*"
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            lr = aWb.Sheets("ketqua").Range("A65000").End(xlUp).Row + 1
            Set Wb = Workbooks.Open(.SelectedItems(i))
                s = Right$(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
                aWb.Sheets("Ketqua").Range("A" & lr).Value = Left(s, InStrRev(s, ".") - 1)
                Arr = Wb.Sheets("2774").Range("D18:D28")
                aWb.Sheets("Ketqua").Range("B" & lr).Resize(, 10) = Application.Transpose(Arr)
            Wb.Close
        Next
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub

 

[alonelove]

Tuyệt vời ạ @giaiphap , tuy nhiên số liệu copy qua vẫn là dạng text ạ, có cách nào chuyển sang dạng number không ạ.

 

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

Chào Anh/Chị ạ

Em có đoạn code tổng hợp số liệu từ nhiều file khác, tất cả file nguồn vùng (D1828) và định dạng text, file đích MAIN.xlsx copy giá trị vùng trên và nối liên tục vào 01 cột sheet("ketqua") định dạng number.
Giờ em muốn:
1. File đích MAIN.xlsx được dán dữ liệu từ Cột thành dòng như sheet("ketquamongmuon")
2. Code cũ lấy giá trị định dạng text dán sang định dạng number tuy nhiên không lấy giá trị sau dấu thập phân nên bị lệch số, giúp em lấy luôn giá trị phần thập phân ạ. Ví dụ file nguồn có text=4200,6 thì sang file MAIN chỉ lấy number 4.200 => mất phần thập phân 0,6

Em đính kèm file MAIN và 3 file nguồn Anh/Chị dễ hình dung ạ.
Em xin cảm ơn trước.

Thử chỉnh lại như sau:

Public Sub DATA_2774()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim cn As Object, rs As Object, i As Byte, lr As Long, fso As Object, rng As Range, vDat As Variant
    Set cn = CreateObject("adodb.connection")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Sheets("ketquamongmuon").Range("A1").CurrentRegion.Offset(1).ClearContents
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "2774", "*.xl*"
        .InitialFileName = "nguon*"
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & .SelectedItems(i) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
            Set rs = cn.Execute("select Val(f1) from [2774$D18:D28] ")
            lr = Sheets("ketquamongmuon").Range("A" & Rows.Count).End(3).Row
            vDat = rs.GetRows
            Set rng = Sheets("ketquamongmuon").Range("A" & lr + 1)
            rng = fso.GetBaseName(.SelectedItems(i))
            rng.Resize(UBound(vDat, 1) + 1, UBound(vDat, 2) + 1).Offset(, 1) = vDat
            rs.Close
            cn.Close
        Next
    End With

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[alonelove]

Dạ em cảm ơn @Hai Lúa Miền Tây code chuyển sang dạng number rồi nhưng phần thập phân vẫn bị mất số liệu ạ (ở ý 2. #1 em đã đề cập). Ví dụ cột L giá trị chỉ là 26, trong khi giá trị đúng phải là 26,9.

 

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

Dạ em cảm ơn @Hai Lúa Miền Tây code chuyển sang dạng number rồi nhưng phần thập phân vẫn bị mất số liệu ạ (ở ý 2. #1 em đã đề cập). Ví dụ cột L giá trị chỉ là 26, trong khi giá trị đúng phải là 26,9.

Bạn kiểm tra lại dữ lieu nguồn xem nó ở dạng text nhé. Dấu phân cách thập phân là dấu phẩy (,). Nếu dấu phân cách thập phân là chấm (.) thì đươc, bạn kiểm tra lại với cách thiết lập trong Control Panel máy bạn xem sao nhé.

 

[alonelove]

Bạn kiểm tra lại dữ lieu nguồn xem nó ở dạng text nhé. Dấu phân cách thập phân là dấu phẩy (,). Nếu dấu phân cách thập phân là chấm (.) thì đươc, bạn kiểm tra lại với cách thiết lập trong Control Panel máy bạn xem sao nhé.

Dạ thì ngay #1 em cũng đề cập là file nguồn dạng text rồi ạ, khổ nỗi máy cơ quan em toàn thiết lập dấu thập phân là phẩy "," nên không được quyền set lại trong Control Panel ngoại trừ IT ^^!.
Anh có phương pháp nào để code nhận diện được dấu thập phân phẩy "," không ạ? many thanks./.

 

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

Dạ thì ngay #1 em cũng đề cập là file nguồn dạng text rồi ạ, khổ nỗi máy cơ quan em toàn thiết lập dấu thập phân là phẩy "," nên không được quyền set lại trong Control Panel ngoại trừ IT ^^!.
Anh có phương pháp nào để code nhận diện được dấu thập phân phẩy "," không ạ? many Cảm ơn./.

Vậy thì dung hàm replace nhé

 Set rs = cn.Execute("select Val(replace(f1,',','.')) from [2774$D18:D28] ")

 

[alonelove]

Perfect anh @Hai Lúa Miền Tây , thay vô là được rồi đấy ạ.

Một lần nữa cảm ơn Anh/Chị đã giúp đỡ.