xin code ạ ! cho e xin copy dữ liệu từ một file đang đóng, Sau đó chia dữ liệu ra theo số mục cần lấy với ạ!

[hoanganhfc]

cho e xin copy dữ liệu từ một file đang đóng, Sau đó chia dữ liệu ra theo số mục cần lấy với ạ!

 

[snow25]

cho e xin copy dữ liệu từ một file đang đóng, Sau đó chia dữ liệu ra theo số mục cần lấy với ạ!

Cho dữ liệu thực tế lên.File để lấy dữ liệu đâu.Bạn đưa lên thế này có mình bạn hiểu thôi.

 

[hoanganhfc]

cho e xin copy dữ liệu từ một file đang đóng, Sau đó chia dữ liệu ra theo số mục cần lấy với ạ!

E GUI

Cho dữ liệu thực tế lên.File để lấy dữ liệu đâu.Bạn đưa lên thế này có mình bạn hiểu thôi.

E GỬI LẠI FILE GIÚP VỚI Ạ!
FILE 1 FILE MUỐN COPY MÀ KHÔNG CẦN MỞ FILE , COPY SANG FILE 2 THÌ CHIA DỮ LIỆU THEO SỐ MỤC KHÁCH HÀNG YÊU CẦU

 

[snow25]

E GUI

E GỬI LẠI FILE GIÚP VỚI Ạ!
FILE 1 FILE MUỐN COPY MÀ KHÔNG CẦN MỞ FILE , COPY SANG FILE 2 THÌ CHIA DỮ LIỆU THEO SỐ MỤC KHÁCH HÀNG YÊU CẦU

Thử cái code này nhé.Đặt chung file nguồn với file kết quả cùng 1 chỗ.

Sub laygiatri()
   Dim i As Long, lr As Long, arr, kq, cn As Object, link As String, sql As String, a As Long, c As Integer, b As Integer
   Set cn = CreateObject("ADODB.Connection")
   link = ThisWorkbook.Path & "\File 1.xlsx"
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & link & ";Extended Properties=""Excel 12.0;HDR=No"";"
  sql = "Select * From [C4$A2:A10000]  where f1 is not null"
  arr = chuyenmang(cn.Execute(sql).getrows)
  cn.Close
  With Sheets("C4")
       c = .Range("G1").Value
       ReDim kq(1 To c, 1 To UBound(arr) \ c + 1)
       For i = 1 To UBound(arr)
           a = (i - 1) Mod c + 1
           b = (i - 1) \ c + 1
           kq(a, b) = arr(i, 1)
       Next i
       .Range("J2:XFD1000").ClearContents
       .Range("J2").Resize(c, b).Value = kq
  End With
  Set cn = Nothing
      
 
End Sub
Private Function chuyenmang(ByVal arr) As Variant
    Dim kq(), i As Long, j As Long
    ReDim kq(1 To UBound(arr, 2) + 1, 1 To UBound(arr, 1) + 1)
    For i = LBound(arr, 2) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            kq(i + 1, j + 1) = arr(j, i)
        Next j
    Next i
    chuyenmang = kq
End Function

 

[hoanganhfc]

Thử cái code này nhé.Đặt chung file nguồn với file kết quả cùng 1 chỗ.

Sub laygiatri()
   Dim i As Long, lr As Long, arr, kq, cn As Object, link As String, sql As String, a As Long, c As Integer, b As Integer
   Set cn = CreateObject("ADODB.Connection")
   link = ThisWorkbook.Path & "\File 1.xlsx"
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & link & ";Extended Properties=""Excel 12.0;HDR=No"";"
  sql = "Select * From [C4$A2:A10000]  where f1 is not null"
  arr = chuyenmang(cn.Execute(sql).getrows)
  cn.Close
  With Sheets("C4")
       c = .Range("G1").Value
       ReDim kq(1 To c, 1 To UBound(arr) \ c + 1)
       For i = 1 To UBound(arr)
           a = (i - 1) Mod c + 1
           b = (i - 1) \ c + 1
           kq(a, b) = arr(i, 1)
       Next i
       .Range("J2:XFD1000").ClearContents
       .Range("J2").Resize(c, b).Value = kq
  End With
  Set cn = Nothing
     
 
End Sub
Private Function chuyenmang(ByVal arr) As Variant
    Dim kq(), i As Long, j As Long
    ReDim kq(1 To UBound(arr, 2) + 1, 1 To UBound(arr, 1) + 1)
    For i = LBound(arr, 2) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            kq(i + 1, j + 1) = arr(j, i)
        Next j
    Next i
    chuyenmang = kq
End Function

E CẢM ƠN NHIỀU Ạ!
CHO HỎI THÊM VỚI A TRƯỜNG HỢP FILE 1 DỮ LIỆU KHÔNG NẰM CÙNG MỘT CỘT THÌ LÀM NHƯ THẾ NÀO Ạ !

 

[snow25]

E CẢM ƠN NHIỀU Ạ!
CHO HỎI THÊM VỚI A TRƯỜNG HỢP FILE 1 DỮ LIỆU KHÔNG NẰM CÙNG MỘT CỘT THÌ LÀM NHƯ THẾ NÀO Ạ !

Bạn tử tìm hiểu thêm nhé.Chỗ câu lệnh sql và vòng lặp ở dưới.Hoặc đưa dữ liệu chuẩn lên.