Lọc dữ liệu tự động từ Insert Comment ... (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
A

Anti-Plus

Thành viên chính thức
Tham gia
25/3/08
Bài viết
65
Được thích
8
Xin chào các bro,

Rất mong các bro hướng dẫn mình cách lọc dữ liệu từ Comment. Ví dụ cụ thể như sau :

- Mình có ô C2 đã được insert comment như hình ảnh minh họa bên dưới.
- & ô B2 dùng để tự động lọc những giá trị từ ô C2 trong comment với những giá trị gồm 2 chữ số cuối cùng có giá trị là số lẻ (nghĩa là 2 số cuối cùng không chia hết cho 2) như hình ảnh minh họa bên dưới.

Rất mong các bro giúp mình nhé ... Xin cám ơn !

comment.jpg
 
Anti-Plus đã viết:
Xin chào các bro,

Rất mong các bro hướng dẫn mình cách lọc dữ liệu từ Comment. Ví dụ cụ thể như sau :

- Mình có ô C2 đã được insert comment như hình ảnh minh họa bên dưới.
- & ô B2 dùng để tự động lọc những giá trị từ ô C2 trong comment với những giá trị gồm 2 chữ số cuối cùng có giá trị là số lẻ (nghĩa là 2 số cuối cùng không chia hết cho 2) như hình ảnh minh họa bên dưới.

Rất mong các bro giúp mình nhé ... Xin cám ơn !
Nhấp chuột vào đây để mở rộng...

oh, bạn upload file lên nhé, và mô tả rõ nên nhẹ
thế thành viên # mới giúp được
.
 
Lần chỉnh sửa cuối:
Bạn dùng macro sau

PHP: 
Option Explicit

Sub CopyCommLeftCell()
' The following macro will copy comment text to the cell to the left, _
    if that cell is empty.' 
 Dim CommRng As Range, myCell As Range
 Dim curWks As Worksheet
 Dim bVTr As Byte, DDai As Byte
 Dim StrM As String, StrC As String, StrL As String
 
  Application.ScreenUpdating = False
  Set curWks = ActiveSheet:                 On Error Resume Next
  Set CommRng = curWks.Cells.SpecialCells(xlCellTypeComments)
  On Error GoTo 0
  If CommRng Is Nothing Then
     MsgBox "No comments found":            Exit Sub
  End If
  For Each myCell In CommRng
    StrC = myCell.Comment.Text:             DDai = Len(StrC)
    If myCell.Offset(, -1) <> "" Then GoTo 26
    For bVTr = 1 To DDai
        If IsNumeric(Mid(StrC, bVTr, 1)) Then
            If Len(StrM) < 1 Then
                StrM = Mid(StrC, bVTr, 1)
            Else
                StrM = StrM & Mid(StrC, bVTr, 1)
            End If
        Else
            If Len(StrM) > 1 Then
                If CInt(Right(StrM, 2)) Mod 2 = 1 Then _
                    StrL = StrL & " " & Right(StrM, 2)
                StrM = ""
            End If
        End If
    Next bVTr
    myCell.Offset(, -1) = StrL:                    StrL =""
26  Next myCell
  
End Sub
 
@SA_DQ : Macro đó sử dụng sao hả bro ? Bro có thể hướng dẫn chi tiết hơn cách dùng macro đó luôn không ? vì mình cũng là lính mới trong excel, Thanks !!!
 
Lần chỉnh sửa cuối:
@SA_DQ : Macro của bro đưa ra đã đúng theo nhu cầu của mình rồi. Xin chân thành cám ơn sự nhiệt tình giúp đỡ của bro.

Một lần nữa mình rất mong bro giúp đỡ mình thêm 1 chút xíu nữa nhé.

- Cũng macro trên & mình vẫn lọc y như y/c trên nhưng mình sẽ lọc loại bỏ qua những số có 2 số cuối cùng là 1 (cụ thể là những cặp số : 01, 11, 21, 31, 41, 51, 61, 71, 81, 91) & 2 số cuối cùng là những số cặp lẻ (cụ thể là những cặp số : 11, 33, 55, 77, 99).

- Vd theo hình ảnh mình họa dưới đây thì ô B2 sẽ tự động lọc ra là : 19 25 19 45 63

comment.jpg

- & thêm 1 Y/C nữa là ô D2 sẽ tự động điền số thuộc về tổng của ô B2, vd theo hình ảnh minh họa ở trên thì ô D2 sẽ tự động điền vào là 5 (5 nghĩa là ô B2 có tổng cộng 5 cặp số).

Xin chân thành cám ơn bro SA_DQ rất nhiều !
 
Anti-Plus đã viết:
@SA_DQ : Macro của bro đưa ra đã đúng theo nhu cầu của mình rồi. Xin chân thành cám ơn sự nhiệt tình giúp đỡ của bro.
Nhấp chuột vào đây để mở rộng...
Hãy nhấn vô nút Thanks là đủ rồi!


Một lần nữa mình rất mong bro giúp đỡ mình thêm 1 chút xíu nữa nhé.

- Cũng macro trên & mình vẫn lọc y như y/c trên nhưng mình sẽ lọc loại bỏ qua những số có 2 số cuối cùng là 1 (cụ thể là những cặp số : 01, 11, 21, 31, 41, 51, 61, 71, 81, 91) & 2 số cuối cùng là những số cặp lẻ (cụ thể là những cặp số : 11, 33, 55, 77, 99).

- Vd theo hình ảnh mình họa thì ô B2 sẽ tự động lọc ra là : 19 25 19 45 63
- & thêm 1 Y/C nữa là ô D2 sẽ tự động điền tổng các số của ô B2, vd theo hình ảnh minh họa ở trên thì ô D2 sẽ tự động điền vào là 5 (5 nghĩa là ô B2 có tổng cộng 5 cặp số).
Xin chân thành cám ơn bro SA_DQ rất nhiều !
Nhấp chuột vào đây để mở rộng...

PHP: 
Option Explicit

Sub CopyCommLeftCell()
 Dim CommRng As Range, myCell As Range
 Dim curWks As Worksheet
 Dim bVTr As Byte, DDai As Byte, bCount As Byte, SoCuoi As Integer
 Dim STemp As String, StrC As String, StrL As String
 
  Application.ScreenUpdating = False
  Set curWks = ActiveSheet:                 On Error Resume Next
  Set CommRng = curWks.Cells.SpecialCells(xlCellTypeComments)
  On Error GoTo 0
  If CommRng Is Nothing Then
     MsgBox "No comments found":            Exit Sub
  End If
  For Each myCell In CommRng
    StrC = myCell.Comment.Text:             DDai = Len(StrC)
    If myCell.Offset(, -1) <> "" Then GoTo 27
    For bVTr = 1 To DDai
        If IsNumeric(Mid(StrC, bVTr, 1)) Then
            STemp = STemp & Mid(StrC, bVTr, 1)
        Else
            If Len(STemp) > 1 Then
                SoCuoi = CInt(Right(STemp, 2))
                If SoCuoi Mod 2 = 1 And Not NoSelect(SoCuoi) Then
                    StrL = StrL & " " & Right(STemp, 2)
                    bCount = bCount + 1
                End If
                STemp = ""
            End If
        End If
    Next bVTr
    myCell.Offset(, -1) = StrL
    If myCell.Offset(, 1) = "" Then myCell.Offset(, 1) = bCount
27  Next myCell
End Sub

Mã: 
Function NoSelect(SCuoi As Integer) As Boolean
 If SCuoi Mod 10 = 1 Or (SCuoi Mod 10 = (SCuoi \ 10) Mod 10) Then _
    NoSelect = True
End Function
 
@SA_DQ : Bro ơi, Macro thứ 2 & HÀM của bro thì mình RUN được rồi. Chỉ còn là kết quả thì vẫn chưa thể hiện đúng so với Macro thứ 1. Mình có gửi kèm file demo theo dưới đây, bro xem & kiểm tra lại giùm mình nhé ... Thanks !!!
 
Lần chỉnh sửa cuối:
Oh, file hình lớn (dung lượng lớn) quá bạn ơi - mở mãi k ra
bạn nên chuyển định dạng jpg / gif / png và quan trọng là độ phân giải là 72px thui
.

Oh phải save về mới thấy

Bạn copy thiếu hàm NoSelect này rùi, bạn copy thêm vào cuối module nhé là OK

PHP: 
 Function NoSelect(SCuoi As Integer) As Boolean
 If SCuoi Mod 10 = 1 Or (SCuoi Mod 10 = (SCuoi \ 10) Mod 10) Then _
    NoSelect = True
End Function
 
Lần chỉnh sửa cuối:
Anti-Plus đã viết:
@SA_DQ : Bro ơi, cái macro thứ 2 mình RUN bị lỗi rồi ... mình không biết cách khắc phục lỗi rất mong bro giúp mình nữa nhé. (Hiện tại thì macro thứ 1 mình vẫn RUN rất tốt). ---> có hình ảnh minh họa về lỗi ở phía dưới !
Nhấp chuột vào đây để mở rộng...
Cái macro thứ hai, như bạn gọi, không phải là macro để chạy/run đâu! Đó là một hàm mình viết để bổ trợ cho macro trên trong lựa chọn (theo iêu cầu mới phát sinh của bạn) mà thôi;
Bạn chạy cái macro thứ nhất của lần gởi sau trên là được kết quả rồi, còn cần gì thử cái thứ hai (cái hàm NoSelect) chi cho mệt zậy?!
Chú í quan trọng: các ô trái & phải của ô có comments phải không chứa dữ liệu trước khi chạy/run macro!!
Nói cách khác: trước khi muốn thấy kết quả của việc macro thực hiện, các ô trái & phải phải không chứa dữ liệu bất kỳ nào.--=0
 
Lần chỉnh sửa cuối:
Bro ơi, xem lại file demo mình gửi kèm theo đó. Kết quả lọc từ comment chưa được thể hiện đúng & Macro khi Run để lọc từ comment thì kết quả số lẻ của 2 số cuối cùng của hàng cuối cùng luôn luôn không được lọc ra để thể hiện kết quả ở ô B2. Thanks !
 
Lần chỉnh sửa cuối:
Đúng là macro còn thiếu 1 lệnh tại dòng trên dòng có số 27 1 dòng
Hiện là: myCell.Offset(, -1) = StrL
Bạn sửa lại giúp là:
Mã: 
   myCell.Offset(, -1) = StrL:             StrL = ""
Cho mình biết kết quả nha!
 
- Macro đã RUN đúng rồi nhưng vẫn còn thiếu 1 chi tiết nữa là khi Run để lọc từ comment thì kết quả số lẻ của 2 số cuối cùng của hàng cuối cùng luôn luôn không được lọc ra để thể hiện kết quả ở ô B2.

- & ô B2 hiển thị kết quả chưa đúng. Vd theo hình ảnh minh họa bên dưới thì comment của ô C4 có số 2 số lẻ của hàng cuối cùng là 23 thì ô B4 không được lọc ra. (hầu hết các cặp số lẻ được nằm ở hàng cuối cùng đều không được lọc ra)

- Tiếp nữa, là ô D2 dùng để tổng cộng lại các cặp số từ ô B2 thì kết quả vẫn chưa được chính xác lắm. Vd cũng theo hình ảnh minh họa bên dưới thì ô D11 đến ô D16 có tổng cộng những cặp số như sau thì mới đúng kết quả Y/C :

D11 = 9
D12 = 2
D13 = 5
D14 = 7
D15 = 7
D16 = 3

Thanks !

editmacro.jpg
 

File đính kèm

Lần chỉnh sửa cuối:
Anh SA_DQ ơi, giúp mình thêm 1 chút nữa nhé ... Rất mong sớm nhận được tin tức từ anh. Thanks !!!
 
Bạn dùng thử code này.(Viết phỏng theo code của bác SA_DQ)
Mã: 
Option Explicit
Sub DatafromComment()
Dim StrChuoilon As String, StrChuoitim As String, StrKetqua as String
Dim CommCell As Range, CommRng As Range
Dim i As Integer, j As Integer
Dim StrChuoinho As Variant
Set CommRng = ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
  On Error Resume Next
   For Each CommCell In CommRng
           StrChuoilon = CommCell.Comment.Text
           StrChuoilon = Replace(StrChuoilon, Chr(10), "-")
           StrChuoinho = Split(StrChuoilon, "-")
               For i = 0 To UBound(StrChuoinho)
                 StrChuoinho(i) = Trim(StrChuoinho(i))
                 StrChuoitim = Right(StrChuoinho(i), 2)
                    If StrChuoitim Mod 2 = 1 Then
                     If Right(StrChuoitim, 1) <> "1" And Right(StrChuoitim, 1) <> Left(StrChuoitim, 1) Then
                       StrKetqua = StrKetqua & " " & StrChuoitim
                       j = j + 1
                     End If
                     End If
                Next
          CommCell.Offset(0, -1) = StrKetqua
          CommCell.Offset(0, 1) = j
          StrKetqua = ""
           j = 0
   Next
End Sub
 

File đính kèm

Anti-Plus đã viết:
Anh SA_DQ ơi, giúp mình thêm 1 chút nữa nhé ... Rất mong sớm nhận được tin tức từ anh. Thanks !!!
Nhấp chuột vào đây để mở rộng...
PHP: 
Option Explicit

Sub CopyCommLeftCell()
 Dim CommRng As Range, myCell As Range
 Dim curWks As Worksheet
 Dim bVTr As Byte, DDai As Byte, bCount As Byte, SoCuoi As Integer
 Dim STemp As String, StrC As String, StrL As String
  
  Application.ScreenUpdating = False
  Set curWks = ActiveSheet:                 On Error Resume Next
  Set CommRng = curWks.Cells.SpecialCells(xlCellTypeComments)
  On Error GoTo 0
  If CommRng Is Nothing Then
     MsgBox "No comments found":                    Exit Sub
  End If
  For Each myCell In CommRng
    StrC = myCell.comment.Text & " ":               DDai = Len(StrC)
    If myCell.Offset(, -1) <> "" Then GoTo 27
    For bVTr = 1 To DDai
        If IsNumeric(Mid(StrC, bVTr, 1)) Then
            STemp = STemp & Mid(StrC, bVTr, 1)
        Else
            If Len(STemp) > 1 Then
                SoCuoi = CInt(Right(STemp, 2))
                If SoCuoi Mod 2 = 1 And Not NoSelect(SoCuoi) Then
                    StrL = StrL & " " & Right(STemp, 2)
                    bCount = bCount + 1
                End If
                STemp = ""
            End If
        End If
    Next bVTr
    myCell.Offset(, -1) = StrL
    If myCell.Offset(, 1) = "" Then myCell.Offset(, 1) = bCount
    bCount = 0
    myCell.Offset(, -1) = StrL:                     StrL = ""
27  Next myCell
End Sub
Mã: 
Function NoSelect(SCuoi As Integer) As Boolean
 If SCuoi Mod 10 = 1 Or (SCuoi Mod 10 = (SCuoi \ 10) Mod 10) Then _
    NoSelect = True
End Function
 
Code của bro SA_DQ đã đúng yêu cầu & kết quả chính xác 100% rồi & đồng thời cũng cám ơn luôn bro voda rất nhiều vì code của bro kết quả cũng đúng Y/C & KQ cũng chính xác 100% giống như pác SA_DQ ... Một lần nữa xin cám ơn bro rất nhiều !
 
Lần chỉnh sửa cuối:
Bro SA_DQ ơi, giúp mình thêm phát nữa nhé.

PHP: 
Option Explicit 
 
Sub CopyCommLeftCell() 
 Dim CommRng As Range, myCell As Range 
 Dim curWks As Worksheet 
 Dim bVTr As Byte, DDai As Byte, bCount As Byte, SoCuoi As Integer 
 Dim STemp As String, StrC As String, StrL As String 
 
  Application.ScreenUpdating = False 
  Set curWks = ActiveSheet:                 On Error Resume Next 
  Set CommRng = curWks.Cells.SpecialCells(xlCellTypeComments) 
  On Error GoTo 0 
  If CommRng Is Nothing Then 
     MsgBox "No comments found":                    Exit Sub 
  End If 
  For Each myCell In CommRng 
    StrC = myCell.comment.Text & " ":               DDai = Len(StrC) 
    If myCell.Offset(, -1) <> "" Then GoTo 27 
    For bVTr = 1 To DDai 
        If IsNumeric(Mid(StrC, bVTr, 1)) Then 
            STemp = STemp & Mid(StrC, bVTr, 1) 
        Else 
            If Len(STemp) > 1 Then 
                SoCuoi = CInt(Right(STemp, 2)) 
                If SoCuoi Mod 2 = 1 And Not NoSelect(SoCuoi) Then 
                    StrL = StrL & " " & Right(STemp, 2) 
                    bCount = bCount + 1 
                End If 
                STemp = "" 
            End If 
        End If 
    Next bVTr 
    myCell.Offset(, -1) = StrL 
    If myCell.Offset(, 1) = "" Then myCell.Offset(, 1) = bCount 
    bCount = 0 
    myCell.Offset(, -1) = StrL:                     StrL = "" 
27  Next myCell 
End Sub  
Function NoSelect(SCuoi As Integer) As Boolean
 If SCuoi Mod 10 = 1 Or (SCuoi Mod 10 = (SCuoi \ 10) Mod 10) Then _
    NoSelect = True
End Function

Cũng từ macro trên & theo hình ảnh minh họa bên dưới thì từ ô D2 đến D8 thì những chuỗi dữ liệu nằm trong đó đang có màu xanh, mình muốn so sánh như sau :

D8 so sánh vơi D7
D7 so sánh với D6
D6 so sánh với D5
D5 so sánh với D4
D4 so sánh với D3
D3 so sánh với D2

Quá trình so sánh giữa các hàng như vậy, nếu có những cặp số trùng nhau thì sẽ tự động thay đổi thành màu đỏ (nghĩa là so sánh từ hàng dưới lên hàng trên).

& từ macro trên khi thực hiện lệnh RUN & phát hiện những ra cặp số lẻ được lọc ra từ ô D2 đến D8 thì trong Comment ta có thể tự động thay đổi luôn những cặp số đó thành mà đỏ luôn có được không (giống như hình ảnh minh họa bên dưới) ?

Mình có kèm theo file demo luôn đó ...

Một lần nữa xin chân thành cám ơn bro rất nhiều vì sự nhiệt tình của bro !

compare_row.jpg
 

File đính kèm

Lần chỉnh sửa cuối:
Anti-Plus đã viết:
Bro SA_DQ ơi, giúp mình thêm phát nữa nhé.
Cũng từ macro trên & theo hình ảnh minh họa bên dưới thì từ ô D2 đến D8 thì những chuỗi dữ liệu nằm trong đó đang có màu xanh, mình muốn so sánh như sau :
D8 so sánh vơi D7
D7 so sánh với D6
D6 so sánh với D5
D5 so sánh với D4
D4 so sánh với D3
D3 so sánh với D2
Quá trình so sánh giữa các hàng như vậy, nếu có những cặp số trùng nhau thì sẽ tự động thay đổi thành màu đỏ (nghĩa là so sánh từ hàng dưới lên hàng trên).
Nhấp chuột vào đây để mở rộng...
Sau trong hình lại tô màu lung tung cả lên vậy;
* Khi so sánh dòng 8 với dòng 7 chỉ có cặp số 45 là giống nhau, sao bạn lại tô cả số 57 & 17 ở dòng 8 là sao?; Mình cho rằng phải chính xác trong thông tin mới làm tiếp được;
 
àh, ô D8 sở dĩ mình tô đỏ 57 & 17 là vì dưới ô D8 vẫn còn tiếp những hàng ở bên dưới nữa ... cái hình đó mình rút gọn lại cho ngắn bớt nên quên bỏ những số đó.

compare_row_fix.jpg
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

M
  • Question Question
cách tạo bản quyền cho file excel bằng Regedit (8 người xem)
Trả lời
1
Đọc
52
tambv2012
T
M
  • Question Question
Chia sẻ code hàm FilterMCLArray dùng lọc mảng 2 chiều (5 người xem)
    • Thích
Trả lời
0
Đọc
31
Minh Tam 2024
M
M
  • Question Question
Chia sẻ các Code liên quan đến Font trong VBA (8 người xem)
Trả lời
4
Đọc
74
Minh Tam 2024
M
S
Export Data from Access to Excel
Trả lời
4
Đọc
475
Yenpham512
Y
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
2 3
Trả lời
51
Đọc
15K
tuanktt3
T
L
Nhờ các bạn cho cách để hướng dẫn cho cháu lớp 2 giải bài toán này (2 người xem)
    • Cười
2
Trả lời
27
Đọc
443
ptm0412
ptm0412
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
333
Đọc
26K
ongke0711
ongke0711
M
  • Question Question
Làm Thế nào CODE VBA để tạo mã QR kèm số tiền và nội dung và Không cần Mạng Internet (9 người xem)
Trả lời
4
Đọc
68
Minh Tam 2024
M
H
Ngày dưới 12 tự động bị đảo ngược ngày thành tháng (3 người xem)
Trả lời
8
Đọc
1K
Giang Đinh
G
H
Chuyển dữ liệu từ dòng thành cột. (6 người xem)
Trả lời
3
Đọc
72
hanhnguyen12022021
H
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
6
Đọc
1K
nmp512
N
N
Có anh chị nào có file tính nghỉ theo NĐ 178, và NĐ 177 mới nhất thời điểm 15/3 không ạ (5 người xem)
Trả lời
0
Đọc
35
nmp512
N
Momominh
Hỏi công thức excel (5 người xem)
Trả lời
0
Đọc
32
Momominh
Momominh
E
Tính tổng số tiền của từng người trên live (2 người xem)
Trả lời
7
Đọc
57
Em khong biet
E
L
[Xin giúp] Cách copy công thức từ bảng tham chiếu vào một ô (1 người xem)
Trả lời
7
Đọc
234
Lá chanh
L
4
Xây dựng bảng đánh giá công việc (1 người xem)
Trả lời
3
Đọc
142
4545
4
D
bài toán cắt thép cho người mới tìm hiểu (1 người xem)
Trả lời
0
Đọc
66
dinnchann
D
LONGBAOKIM
Cách phân tích What if - Phân tích độ nhạy 2 chiều
    • Cười
Trả lời
15
Đọc
681
ptm0412
ptm0412
N
Tạo công thức đánh số thứ tự
Trả lời
2
Đọc
131
HUONGHCKT
H
N
e cần hỗ trợ code vba từ các a chị trên đây ạ.
Trả lời
2
Đọc
162
bebo021999
B
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom