Xin giúp code lấy dữ liệu (1 người xem)

[phuoclocvl]

Chào các pro,

xin giúp giùm code em code lấy dữ liệu theo điều kiện cột U từ U5 cho đến U20000 những ô nào lớn hơn 0 thì sẽ lấy dữ liệu của cột A sheet data sang cột A sheet Get
nhưng em viết code như bên dưới nó không lấy theo điều kiện mà nó lấy hết dữ liệu qua luôn.
xin giúp đỡ.
file đính kèm View attachment 89222


Private Sub data()
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("get").Range("A4:A20000").Clear
For i = 5 To Worksheets("data").Range("U20000").End(xlUp).Row
If Worksheets("data").Range("U" & i).Value > 0 Then
Worksheets("get").Range("A4" & ":" & "a20000").Value = Worksheets("data").Range("A3" & ":" & "a20000").Value
Exit For
End If
Next i
End Sub

 

[Quang_Hải]

Chào các pro,

xin giúp giùm code em code lấy dữ liệu theo điều kiện cột U từ U5 cho đến U20000 những ô nào lớn hơn 0 thì sẽ lấy dữ liệu của cột A sheet data sang cột A sheet Get
nhưng em viết code như bên dưới nó không lấy theo điều kiện mà nó lấy hết dữ liệu qua luôn.
xin giúp đỡ.
file đính kèm View attachment 89222

Xem code này coi được không,

Sub loc()
Dim dl
Sheets("Get").[a4:a10000].ClearContents
With Sheets("data")
  Set dl = .Range(.[A3], .[U65536].End(3))
End With
With dl
  .AutoFilter 21, ">0"
  .Resize(, 1).SpecialCells(12).Copy Sheets("Get").[a4]
  .AutoFilter
End With
End Sub

 

[ndu96081631]

Chào các pro,

xin giúp giùm code em code lấy dữ liệu theo điều kiện cột U từ U5 cho đến U20000 những ô nào lớn hơn 0 thì sẽ lấy dữ liệu của cột A sheet data sang cột A sheet Get
nhưng em viết code như bên dưới nó không lấy theo điều kiện mà nó lấy hết dữ liệu qua luôn.
xin giúp đỡ.
file đính kèm View attachment 89222


Private Sub data()
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("get").Range("A4:A20000").Clear
For i = 5 To Worksheets("data").Range("U20000").End(xlUp).Row
If Worksheets("data").Range("U" & i).Value > 0 Then
Worksheets("get").Range("A4" & ":" & "a20000").Value = Worksheets("data").Range("A3" & ":" & "a20000").Value
Exit For
End If
Next i
End Sub

Dùng For Next không có gì đáng nói cả (chỉ là bạn đã code sai)
Giới thiệu bạn phương pháp Advanced Filter nhé --> tốc độ cũng rất nhanh:

Sub Main()
  Dim tmp As String
  Dim wksData As Worksheet, wksGet As Worksheet
  Set wksData = Sheets("Data")
  Set wksGet = Sheets("Get")
  With wksData
    .Range("IV2").Value = .Range("U2").Value
    .Range("IV3").Value = ">0"
    With wksGet
      .Range("A4:A60000").Clear
      tmp = .Range("A3").Value
      .Range("A3").Value = Sheet3.Range("A2").Value
    End With
    .Range("A2:U60000").AdvancedFilter 2, .Range("IV2:IV3"), wksGet.Range("A3")
    .Range("IV2:IV3").Clear
  End With
  wksGet.Range("A3").Value = tmp
End Sub

-----------------------

Xem code này coi được không,

Dữ liệu từ 5000 dòng trở lên, dùng AutoFilter + SpecialCells không tốt lắm đâu

 

[phuoclocvl]

có cách nào cho nó tự update khi có dữ liệu mới không ?
thanks

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Chào các pro,

xin giúp giùm code em code lấy dữ liệu theo điều kiện cột U từ U5 cho đến U20000 những ô nào lớn hơn 0 thì sẽ lấy dữ liệu của cột A sheet data sang cột A sheet Get
nhưng em viết code như bên dưới nó không lấy theo điều kiện mà nó lấy hết dữ liệu qua luôn.
xin giúp đỡ.
file đính kèm View attachment 89222


Private Sub data()
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("get").Range("A4:A20000").Clear
For i = 5 To Worksheets("data").Range("U20000").End(xlUp).Row
If Worksheets("data").Range("U" & i).Value > 0 Then
Worksheets("get").Range("A4" & ":" & "a20000").Value = Worksheets("data").Range("A3" & ":" & "a20000").Value
Exit For
End If
Next i
End Sub

Ngoài theo cách Thầy Tuấn ra với dữ liệu nhiều ta nên dùng ADO để lọc cho khỏe.

Sub LayDL()
Dim strPath, mySQL As String
Dim Cnn As New ADODB.Connection
Dim Rcs As New ADODB.Recordset
strPath = ThisWorkbook.FullName


Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & _
                            ";Persist Security Info=False; Extended Properties=Excel 8.0;"
                            
mySQL = "select [ORDNO] " & _
        "from [Data$] " & _
        "where [QTY /SH]>0 "


Rcs.Open mySQL, Cnn, 1, 3


With Sheets("Get")
    .[A4:A60000].ClearContents
    .[A4].CopyFromRecordset Rcs
End With


Rcs.Close: Set Rcs = Nothing
Cnn.Close: Set Cnn = Nothing


End Sub

 

[phuoclocvl]

Ngoài theo cách Thầy Tuấn ra với dữ liệu nhiều ta nên dùng ADO để lọc cho khỏe.

Sub LayDL()
Dim strPath, mySQL As String
Dim Cnn As New ADODB.Connection
Dim Rcs As New ADODB.Recordset
strPath = ThisWorkbook.FullName


Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & _
                            ";Persist Security Info=False; Extended Properties=Excel 8.0;"
                            
mySQL = "select [ORDNO] " & _
        "from [Data$] " & _
        "where [QTY /SH]>0 "


Rcs.Open mySQL, Cnn, 1, 3


With Sheets("Get")
    .[A4:A60000].ClearContents
    .[A4].CopyFromRecordset Rcs
End With


Rcs.Close: Set Rcs = Nothing
Cnn.Close: Set Cnn = Nothing


End Sub

sao mình dùng code của bác chep vào nó báo lỗi, không chạy được.
xin giúp đỡ.

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

sao mình dùng code của bác chep vào nó báo lỗi, không chạy được.
xin giúp đỡ.

1./ Bạn làm theo bài #1 của HLMT ADO căn bản: Kết nối truy vấn CSDL từ file Excel đến file Access.
2./ Sheet Data của bạn nên bỏ dòng A1 theo như ví dụ của mình.
3./ Chép code và chạy thử.

 

[ndu96081631]

có cách nào cho nó tự update khi có dữ liệu mới không ?
thanks

Cho code vào sự kiện Worksheet_Activate() là nó update thôi (tức khi ta active sheet GET, code sẽ chạy)

 

[phuoclocvl]

Ngoài theo cách Thầy Tuấn ra với dữ liệu nhiều ta nên dùng ADO để lọc cho khỏe.

cho em hỏi thêm tí, em muốn lấy những cột mình cần thôi và với đk cột số lượng lớn hơn 0, em viết code như vậy có đúng không, sao tất cả các cột đều lấy hết dữ liêu trừ cột CITEM chỉ lấy được vài trăm dòng thôi. xin giúp giùm em.Thanks
xem file đính kèm. http://www.mediafire.com/?14mv4pxlujkp5nz

Public Sub LayData()

Dim strPath, mySQL As String
Dim Cnn As New ADODB.Connection
Dim Rcs As New ADODB.Recordset
strPath = ThisWorkbook.FullName

Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & _
";Persist Security Info=False; Extended Properties=Excel 8.0;"

mySQL = "select [ORDNO],[MOFG],[CITEM],[QTY /SH],[DUE],[MSSENDDATE],[SECTION]" & _
"from [Data$] " & _
"where [QTY /SH]>0 "

Rcs.Open mySQL, Cnn, 1, 3

With Sheets("Get")
.[A5:Z60000].ClearContents
.[A5].CopyFromRecordset Rcs
End With

Rcs.Close: Set Rcs = Nothing
Cnn.Close: Set Cnn = Nothing
End Sub

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Code Ok đâu có sai gì, kết quả như bạn miêu tả rồi còn gì. Lưu ý là ở cuối dòng phải có khoảng trắng nhé.

"select [ORDNO],[MOFG],[CITEM],[QTY /SH],[DUE],[MSSENDDATE],[SECTION] "

 

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

Code Ok đâu có sai gì, kết quả như bạn miêu tả rồi còn gì. Lưu ý là ở cuối dòng phải có khoảng trắng nhé.

Do dữ liệu cột CITEM vừa là số vừa là Text nên nó không nhận, trong các trường CSDL bạn phải qui định rõ ràng các kiểu của nó.
TRong trường hợp này nên chuyển toàn bộ trường này về dạng text.

 

[phuoclocvl]

Code Ok đâu có sai gì, kết quả như bạn miêu tả rồi còn gì. Lưu ý là ở cuối dòng phải có khoảng trắng nhé.

thank bác nha, vấn đề là phải convert cột đó sang text nó mới lấy dữ liệu được. không biết có cách nào hay hơn hok biết

 

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

thank bác nha, vấn đề là phải convert cột đó sang text nó mới lấy dữ liệu được. không biết có cách nào hay hơn hok biết

Nếu dùng ADO thì không còn cách nào hết bạn à.

 

[Ba Tê]

thank bác nha, vấn đề là phải convert cột đó sang text nó mới lấy dữ liệu được. không biết có cách nào hay hơn hok biết

Dùng VBA bình thường được không?

Public Sub GPE()
Dim Rng(), Arr(), I As Long, K As Long
With Sheets("Data")
    Rng = .Range(.[A3], .[A65000].End(xlUp)).Resize(, 23).Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 8)
    For I = 1 To UBound(Rng, 1)
        If IsNumeric(Rng(I, 21)) Then
            If Rng(I, 21) > 0 Then
                K = K + 1: Arr(K, 1) = Rng(I, 1)
                Arr(K, 2) = Rng(I, 15): Arr(K, 3) = Rng(I, 8)
                Arr(K, 4) = Rng(I, 21): Arr(K, 5) = Rng(I, 23)
                Arr(K, 6) = Rng(I, 22): Arr(K, 7) = Rng(I, 13)
            End If
        End If
    Next I
With Sheets("GET")
    .[A4:H65000].ClearContents
    If K Then .[A4].Resize(K, 7).Value = Arr
End With
End Sub