Nhờ anh chị sửa giúp đoạn code lọc dữ liệu? (1 người xem)

[ngoclinh28061991]

Em có một bảng dữ liệu, em muốn lọc ra những dòng số liệu giống nhau ở cột A ra các cột khác, giống như file đính kèm, nhưng code của em viết sai, mà không biết sai chỗ nào? nhờ anh chị sửa giúp em.

Sub sapxep()
    Dim ws As Worksheet
    Dim i, j As Integer
    Set ws = Sheets("Sheet1")
    i = 1
    j = 1
    Do While ws.Cells(1, i) <> " "
  
        If ws.Cells(1, i) = "140.05" Then
        ws.Cells(4, j) = ws.Cells(1, i)
        ws.Cells(5, j) = ws.Cells(2, i)
        j = j + 1
        End If
        i = i + 1
        Loop
              
End Sub

 

[leonguyenz]

Em có một bảng dữ liệu, em muốn lọc ra những dòng số liệu giống nhau ở cột A ra các cột khác, giống như file đính kèm, nhưng code của em viết sai, mà không biết sai chỗ nào? nhờ anh chị sửa giúp em.

Sub sapxep()
    Dim ws As Worksheet
    Dim i, j As Integer
    Set ws = Sheets("Sheet1")
    i = 1
    j = 1
    Do While ws.Cells(1, i) <> " "
  
        If ws.Cells(1, i) = "140.05" Then
        ws.Cells(4, j) = ws.Cells(1, i)
        ws.Cells(5, j) = ws.Cells(2, i)
        j = j + 1
        End If
        i = i + 1
        Loop
              
End Sub

Bạn chưa khai báo biến i và nhầm lẫn dòng, cột trong Cells:

Sub sapxep()
    Dim ws As Worksheet
    Dim i As Integer, j As Integer
    Set ws = Sheets("Sheet1")
    i = 2
    j = 2
    Do While ws.Cells(i, 1) <> ""
        If ws.Cells(i, 1) = "140.05" Then
            ws.Cells(j, 4) = ws.Cells(i, 1)
            ws.Cells(j, 5) = ws.Cells(i, 2)
            j = j + 1
        End If
        i = i + 1
    Loop
End Sub

 

[ngoclinh28061991]

Em làm được rồi, cảm ơn anh Mr.Bum rất nhiều.

 

[Ba Tê]

Em có một bảng dữ liệu, em muốn lọc ra những dòng số liệu giống nhau ở cột A ra các cột khác, giống như file đính kèm, nhưng code của em viết sai, mà không biết sai chỗ nào? nhờ anh chị sửa giúp em.

Sub sapxep()
    Dim ws As Worksheet
    Dim i, j As Integer
    Set ws = Sheets("Sheet1")
    i = 1
    j = 1
    Do While ws.Cells(1, i) <> " "
  
        If ws.Cells(1, i) = "140.05" Then
        ws.Cells(4, j) = ws.Cells(1, i)
        ws.Cells(5, j) = ws.Cells(2, i)
        j = j + 1
        End If
        i = i + 1
        Loop
              
End Sub

Thử chạy Sub "Tà đạo" này xem sao. Nhớ Lưu file kiểu .xlsm và Enable Macros khi mở file.
[GPECODE=vb]Public Sub GPexX()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, C As Long, MaxK As Long
C = -2
With Sheet1
.Range(.[A2], .[B1048576].End(xlUp)).Copy
.Range("XFC2").PasteSpecial (xlPasteValues)
.Range(.[XFC2], .[XFD1048576].End(xlUp)).Sort Key1:=.[XFC2]
sArr = .Range(.[XFC1], .[XFD1048576].End(xlUp)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 1) * 2)
For I = 2 To UBound(sArr, 1)
If sArr(I, 1) <> sArr(I - 1, 1) Then
C = C + 3
K = 1
Else
K = K + 1
End If
If K > MaxK Then MaxK = K
dArr(K, C) = sArr(I, 1)
dArr(K, C + 1) = sArr(I, 2)
Next I
.[D2].Resize(MaxK, C + 1) = dArr
.Range(.[XFC1], .[XFD1048576].End(xlUp)).ClearContents
End With
Application.ScreenUpdating = True
End Sub[/GPECODE]