Tách dữ liệu từ một bảng tổng hợp

Liên hệ QC
Giúp em tìm hiểu phương thức Worksheet_SelectionChange(ByVal Target As Range)

Em sửa thành như thế này thì chạy không được, vậy ta phải sửa sao hả các bác

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [E1]) Is Nothing Then
    Dim iDL, i As Long, j As Long, eR As Long
    Dim Cty As String, iCty As String
        Sheet1.Range("F2:H500").ClearContents
        eR = Sheet1.Range("A65000").End(xlUp).Row
        Cty = Range("Sheet1!E1").Value
        j = 2
        For i = 2 To eR
            iCty = Sheet1.Range("B" & i & ":B" & i).Value
            Set DL = Sheet1.Range("A" & i & ":C" & i)
            Set KQ = Sheet1.Range("F" & j & ":H" & j)
            If iCty = Cty Then
                KQ.Value = DL.Value
                j = j + 1
            End If
        Next
    End If
End Sub
 
PHP:
Sub Loc()
    Dim iDL, i As Long, j As Long, eR As Long
    Dim Cty As String, iCty As String
    Sheet1.Range("F2:H500").ClearContents
    eR = Range("Sheet1!A65000").End(xlUp).Row
    Cty = Range("Sheet1!E1").Value
    j = 2
    For i = 2 To eR
        iCty = Range("Sheet1!B" & i & ":B" & i).Value
        Set DL = Range("Sheet1!A" & i & ":C" & i)
        Set KQ = Range("Sheet1!F" & j & ":H" & j)
        If iCty = Cty Then
            KQ.Value = DL.Value
            j = j + 1
        End If
    Next
End Sub

Cho tôi hỏi có thể cho 2 Range bằng nhau trực tiếp bằng mỗi lệnh KQ.Value = DL.Value đơn giản vậy, thế 2 mảng có cách nào gán cho nó bằng nhau bằng một lệnh không? Đại để như sau:

PHP:
DL = Range("Sheet1!A" & i & ":C" & i).Value
        KQ = Range("Sheet1!F" & j & ":H" & j).Value
        If iCty = Cty Then
            KQ = DL
            j = j + 1
        End If
 
Tôi chưa hiểu lắm về =Cells(Rw, "F").End(xlUp).Offset(1) trong Code sau, nhờ mọi người giải thích dùm
PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [E1]) Is Nothing Then
    Dim Cls As Range, Rng As Range, Rw As Long
        Set Rng = Range([B3], [B65500].End(xlUp))
        Rw = Rng.Rows.Count
        [F2].Resize(Rw, 4).ClearContents
        For Each Cls In Rng
            If Cls.Value = Target.Value Then
                Cls.Offset(, -1).Resize(, 3).Copy Destination:=Cells(Rw, "F").End(xlUp).Offset(1)
            End If
        Next Cls
    End If
End Sub
 
Tôi chưa hiểu lắm về =Cells(Rw, "F").End(xlUp).Offset(1) trong Code sau, nhờ
Lệnh trên tương đương với việc bạn đưa con trỏ đến cell Cells(Rw, "F") (hàng cuối của Rng cột F) sau đó nhấn Ctrl+ mũi tên lên (End(xlUp)) rồi nhấn mũi tên xuống (Offset(1) )
 
Web KT

Bài viết mới nhất

Back
Top Bottom