Cắt dữ liệu đưa qua vị trí mới (1 người xem)

[matran25251325]

Hiện em đang làm dữ liệu đầu vào (từ dữ liệu trên mạng) để ứng dụng trong công việc. Nhưng có cái khổ là phải làm thủ công là Cắt vùng dữ liệu và đưa qua vị trí khác. Vậy cho em hỏi có cách nào làm nhanh hơn ko? (VBA càng tốt) Vì dữ liệu rất nhiều nên em đành mạo mụi hỏi. Vùng cắt là vùng màu vàng, vùng dán vào là vùng màu xanh. Hy vọng sẽ có cách giải quyết nhanh thay vì phải Ctr+x và Ctr+V.

 

[SA_DQ]

Bạn xem theo file

Bấm tổ hợp {CTRL}+{SHIFT}+C
để thấy kết quả

 

[matran25251325]

File bài 2 của anh là Copy vùng dữ liệu cũ rồi past qua, còn ý em hỏi là cắt dữ liệu và past qua luôn anh. Vậy trong code em sẽ sửa thế nào ạ.

 

[SA_DQ]

Đây, bạn thử với cái ni; Nhưng trước đó nhớ sao lưu:

Option Explicit

Sub CopyAll()
1 Dim Rng As Range, sRng As Range, Cls As Range, Rg0 As Range, dRg As Range
 Dim fAdd As String, TFHF As String:                    Dim J As Byte
  
3 Sheets("GPE").Select:                                  Set dRg = [AA1]
 Set Rng = Range([c6], [c65500].End(xlUp))
 Columns("G:I").ClearContents
 Application.ScreenUpdating = False
 For J = 1 To 3
    TFHF = Cells(Choose(J, 5, 7, 9), "AA").Value
    Set sRng = Rng.Find(TFHF, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        fAdd = sRng.Address
        Do
            Cells(sRng.Row, "G").Value = sRng.Value
14            Set dRg = Union(dRg, sRng)
            Set Rg0 = sRng.Offset(1, -1).Resize(13)
            For Each Cls In Rg0
                If Cls.Value = "" Then Exit For
                Cells(Cls.Row, "G").Resize(, 3).Value = Cls.Offset(, 1).Resize(, 3).Value
19                Set dRg = Union(dRg, Cls.Offset(, 1).Resize(, 3))         '<=|'
            Next Cls
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> fAdd
    End If
 Next J
25 If Not dRg Is Nothing Then dRg.Value = ""
 Application.ScreenUpdating = True
 Randomize
 [G5].Resize(2, 3).Interior.ColorIndex = 34 + 9 * Rnd \ 1
End Sub

 

[matran25251325]

Hic em chạy thủ Dữ liệu 10k dòng thì file treo luôn.

 

[ndu96081631]

Hiện em đang làm dữ liệu đầu vào (từ dữ liệu trên mạng) để ứng dụng trong công việc. Nhưng có cái khổ là phải làm thủ công là Cắt vùng dữ liệu và đưa qua vị trí khác. Vậy cho em hỏi có cách nào làm nhanh hơn ko? (VBA càng tốt) Vì dữ liệu rất nhiều nên em đành mạo mụi hỏi. Vùng cắt là vùng màu vàng, vùng dán vào là vùng màu xanh. Hy vọng sẽ có cách giải quyết nhanh thay vì phải Ctr+x và Ctr+V.

Code vầy xem:

Sub FCCopy(ByVal SourceRange As Range, Target As Range)
  Dim aSrc, aDest
  Dim lR As Long
  aSrc = SourceRange.Resize(, 5).Value
  ReDim aDest(1 To UBound(aSrc, 1), 1 To 3)
  For lR = 1 To UBound(aSrc, 1)
    If IsEmpty(aSrc(lR, 1)) Then
      aDest(lR, 1) = aSrc(lR, 3)
      aDest(lR, 2) = aSrc(lR, 4)
      aDest(lR, 3) = aSrc(lR, 5)
    End If
  Next
  If lR > 2 Then Target.Resize(lR - 1, 3).Value = aDest
End Sub
Sub Main()
  Dim SourceRange As Range, Target As Range
  [COLOR=#ff0000]Set SourceRange = Sheet1.Range("A7:E60000")[/COLOR]
  [COLOR=#0000cd]Set Target = Sheet1.Range("G7")[/COLOR]
  FCCopy SourceRange, Target
End Sub

Màu đỏ: Khai báo vùng dữ liệu
Màu xanh: Khai báo nơi đặt kết quả

 

[VetMini]

Chủ thớt có yêu cầu rắc rối bỏ bố mà không chịu giải thích cặn kẽ. Loại câu hỏi này ít nhất phải chục lần "anh ơi, vẫn chưa đúng" mới xong hết.

Yêu cầu là cắt vùng vàng cho sang vùng xanh. Cái này thì dễ rồi, chỉ cần xét ô màu vàng, cóp nó qua màu xanh bên phải.
Nhưng chĩnh chủ thớt cũng nói dữ liệu nhiều, không muốn bỏ công cut/paste. Chả nhẽ lại bỏ công đi tô màu?

Quan sát toét con mắt mới thấy có vẻ như:
- Ở cột B, chỗ nào có dữ liệu thì biết là cần cắt dữ liệu bên cột C+D+E sang cột G+H+I
- Lúc cóp thì cóp luôn một dòng trên nó (hình như là chủng loại)

 

[matran25251325]

Hic bác vetmini khó tính quá, tô màu là em tô chỉ để diễn tả để dễ hiểu chứ quan trọng là dữ liệu Cut và Past dữ liệu.
Cảm ơn thầy Ndu, em test thử xem sao.

 

[matran25251325]

Thầy Ndu ơi sao vùng cut qua (vùng cột C, D, E) vẫn chưa được xóa. Vùng cop qua thì đúng và nhanh tuyệt vời nhưng vùng màu vàng thầy chỉnh giúp em cho nó xóa đi luôn ạ (làm thủ công thì em Cut vùng màu vàng và past qua cột G, H, I). Sau khi chạy code thì em mún dữ liệu như trong file đính kèm.

 

[siwtom]

Thầy Ndu ơi sao vùng cut qua (vùng cột C, D, E) vẫn chưa được xóa. Vùng cop qua thì đúng và nhanh tuyệt vời nhưng vùng màu vàng thầy chỉnh giúp em cho nó xóa đi luôn ạ (làm thủ công thì em Cut vùng màu vàng và past qua cột G, H, I). Sau khi chạy code thì em mún dữ liệu như trong file đính kèm.

Bạn thử code này xem sao

Sub CutData(Ma As Range, PasteCell As Range)
Dim Data(), result(), r As Long
    Data = Ma.Value
    result = Ma.Offset(, 2).Resize(, 3).Value
    For r = 1 To UBound(Data)
        If IsEmpty(Data(r, 1)) Then
            Data(r, 3) = ""
            Data(r, 4) = ""
            Data(r, 5) = ""
        Else
            result(r, 1) = ""
            result(r, 2) = ""
            result(r, 3) = ""
        End If
    Next
    PasteCell.Resize(r - 1, 3).Value = result
    Ma.Value = Data
End Sub

Sub DoCut()
Dim Ma As Range, lastRow As Long
    lastRow = Sheet1.Range("E65535").End(xlUp).Row
    If lastRow > 7 Then
        Set Ma = Sheet1.Range("A7:E" & lastRow)
        CutData Ma, Sheet1.Range("G7")
    End If
End Sub

 

[matran25251325]

Tuyệt quá thầy Tom ơi. TK thầy nhiều. Hic nhờ có code này mà em làm dữ liệu đỡ tốn 1 đóng thời gian.