Thêm "comment" vào sheet "kết quả" thì sửa code như thế nào? (1 người xem)

[minhcong.tckt]

Em có đoạn code sau, giờ giả sử ở sheet3 (sheet nhập dữ liệu chính) em có một số comment trong ô; vậy sau khi lọc sang sheet4 làm thế nào để ô kết quả comment đó cũng "đi theo" ạ

Sub CmdBtt1()    With Application        .ScreenUpdating = False        .Calculation = xlCalculationManual        .EnableEvents = False        On Error GoTo ExitSub        Dim sArray, MyArr, i As Long, j As Long        Call TestRow        sArray = Range(Sheet3.[B7], Sheet3.[L1000].End(xlUp)).Value        sArray = Filter2DArray(sArray, 11, Sheet4.ComboBox1, False)        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)        ReDim MyArr(1 To UBound(sArray), 1 To 11)        For i = 1 To UBound(sArray)            MyArr(i, 1) = i            For j = 1 To 10                MyArr(i, j + 1) = sArray(i, j)            Next        Next                    'Thu tuc kiem tra so hàng truoc khi nhap lieu:        With Sheet4            i = UBound(MyArr)            If i > 12 Then                i = i - 13                .Range("A9:GG" & 9 + i).Insert 2            End If        End With                Sheet4.Range("A8").Resize(UBound(MyArr), 11).Value = MyArrExitSub:        .EnableEvents = True        .Calculation = xlCalculationAutomatic        .ScreenUpdating = True    End WithEnd Sub

[FONT=Verdana]Sub CmdBtt1()    With Application        .ScreenUpdating = False        .Calculation = xlCalculationManual        .EnableEvents = False        On Error GoTo ExitSub        Dim sArray, MyArr, i As Long, j As Long        Call TestRow        sArray = Range(Sheet3.[B7], Sheet3.[L1000].End(xlUp)).Value        sArray = Filter2DArray(sArray, 11, Sheet4.ComboBox1, False)        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)        ReDim MyArr(1 To UBound(sArray), 1 To 11)        For i = 1 To UBound(sArray)            MyArr(i, 1) = i            For j = 1 To 10                MyArr(i, j + 1) = sArray(i, j)            Next        Next                    'Thu tuc kiem tra so hàng truoc khi nhap lieu:        With Sheet4            i = UBound(MyArr)            If i > 12 Then                i = i - 13                .Range("A9:GG" & 9 + i).Insert 2            End If        End With                Sheet4.Range("A8").Resize(UBound(MyArr), 11).Value = MyArrExitSub:        .EnableEvents = True        .Calculation = xlCalculationAutomatic        .ScreenUpdating = True    End WithEnd Sub[/FONT]

 

[minhcong.tckt]

em gửi file đính kèm, các bác giúp em với ạ

 

[nghiaphuc]

Em có đoạn code sau, giờ giả sử ở sheet3 (sheet nhập dữ liệu chính) em có một số comment trong ô; vậy sau khi lọc sang sheet4 làm thế nào để ô kết quả comment đó cũng "đi theo" ạ

Sub CmdBtt1()    With Application        .ScreenUpdating = False        .Calculation = xlCalculationManual        .EnableEvents = False        On Error GoTo ExitSub        Dim sArray, MyArr, i As Long, j As Long        Call TestRow        sArray = Range(Sheet3.[B7], Sheet3.[L1000].End(xlUp)).Value        sArray = Filter2DArray(sArray, 11, Sheet4.ComboBox1, False)        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)        ReDim MyArr(1 To UBound(sArray), 1 To 11)        For i = 1 To UBound(sArray)            MyArr(i, 1) = i            For j = 1 To 10                MyArr(i, j + 1) = sArray(i, j)            Next        Next                    'Thu tuc kiem tra so hàng truoc khi nhap lieu:        With Sheet4            i = UBound(MyArr)            If i > 12 Then                i = i - 13                .Range("A9:GG" & 9 + i).Insert 2            End If        End With                Sheet4.Range("A8").Resize(UBound(MyArr), 11).Value = MyArrExitSub:        .EnableEvents = True        .Calculation = xlCalculationAutomatic        .ScreenUpdating = True    End WithEnd Sub

[FONT=Verdana]Sub CmdBtt1()    With Application        .ScreenUpdating = False        .Calculation = xlCalculationManual        .EnableEvents = False        On Error GoTo ExitSub        Dim sArray, MyArr, i As Long, j As Long        Call TestRow        sArray = Range(Sheet3.[B7], Sheet3.[L1000].End(xlUp)).Value        sArray = Filter2DArray(sArray, 11, Sheet4.ComboBox1, False)        'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)        ReDim MyArr(1 To UBound(sArray), 1 To 11)        For i = 1 To UBound(sArray)            MyArr(i, 1) = i            For j = 1 To 10                MyArr(i, j + 1) = sArray(i, j)            Next        Next                    'Thu tuc kiem tra so hàng truoc khi nhap lieu:        With Sheet4            i = UBound(MyArr)            If i > 12 Then                i = i - 13                .Range("A9:GG" & 9 + i).Insert 2            End If        End With                Sheet4.Range("A8").Resize(UBound(MyArr), 11).Value = MyArrExitSub:        .EnableEvents = True        .Calculation = xlCalculationAutomatic        .ScreenUpdating = True    End WithEnd Sub[/FONT]

Dán code vào tag GPECODE đi bạn. Code kiểu này đọc mờ mắt luôn mà không ra.

 

[minhcong.tckt]

Dán code vào tag GPECODE đi bạn. Code kiểu này đọc mờ mắt luôn mà không ra.

[GPECODE=vb]Sub CmdBtt1() With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
On Error GoTo ExitSub
Dim sArray, MyArr, i As Long, j As Long
Call TestRow
sArray = Range(Sheet3.[B7], Sheet3.[I65536].End(xlUp)).Value
sArray = Filter2DArray(sArray, 7, Sheet4.ComboBox1, False)
'sArray = Filter2DArray(sArray, 8, Sheet4.ComboBox2, False)
ReDim MyArr(1 To UBound(sArray), 1 To 7)
For i = 1 To UBound(sArray)
MyArr(i, 1) = i
For j = 1 To 6
MyArr(i, j + 1) = sArray(i, j)
Next
Next

'Thu tuc kiem tra so hàng truoc khi nhap lieu:
With Sheet4
i = UBound(MyArr)
If i > 12 Then
i = i - 13
.Range("A9:G" & 9 + i).Insert 2
End If
End With
Sheet4.Range("A8").Resize(UBound(MyArr), 7).Value = MyArr
ExitSub:
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub[/GPECODE]
Các bác giúp em kéo comment ở sheet3 sang sheet4 với ạ

 

[minhcong.tckt]

Có ai giúp em với không ạ
Anh chị có thể tải file đính kèm tại bài 2