Lọc dữ liệu theo điều kiện

Liên hệ QC
huongmuine

huongmuine

Thành viên GPE
Tham gia
27/5/10
Bài viết
225
Được thích
32
Giới tính
Nam
Mình muốn lọc danh sách từ sheet Data sang sheet Loc theo kết quả tại sheet Loc. Nếu các mã khuyết tật có ký tự X- đứng đầu sẽ đánh dấu x vào cột "Có giấy chứng nhận". Xin cảm ơn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
huongmuine đã viết:
Mình muốn lọc danh sách từ sheet Data sang sheet Loc theo kết quả tại sheet Loc. Nếu các mã khuyết tật có ký tự X- đứng đầu sẽ đánh dấu x vào cột "Có giấy chứng nhận". Xin cảm ơn.
Nhấp chuột vào đây để mở rộng...
Tham khảo code và file đính kèm.
Mã: 
Sub Loc()
Dim sArr(), dArr(), i As Long, j As Long
sArr = Sheet1.Range("A9:D" & Sheet1.Range("A65535").End(3).Row).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 4) <> "" Then
        j = j + 1
        dArr(j, 1) = j
        dArr(j, 2) = sArr(i, 2)
        If InStr(sArr(i, 4), "X-") Then
            dArr(j, 3) = Replace(sArr(i, 4), "X-", "")
            dArr(j, 5) = "X"
        Else
            dArr(j, 3) = sArr(i, 4)
        End If
    End If
Next i
If j Then
    Sheet2.Range("A6:E1000").ClearContents
    Sheet2.Range("A6").Resize(j, 5) = dArr
End If
End Sub
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Tham khảo code và file đính kèm.
Mã: 
Sub Loc()
Dim sArr(), dArr(), i As Long, j As Long
sArr = Sheet1.Range("A9:D" & Sheet1.Range("A65535").End(3).Row).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 4) <> "" Then
        j = j + 1
        dArr(j, 1) = j
        dArr(j, 2) = sArr(i, 2)
        If InStr(sArr(i, 4), "X-") Then
            dArr(j, 3) = Replace(sArr(i, 4), "X-", "")
            dArr(j, 5) = "X"
        Else
            dArr(j, 3) = sArr(i, 4)
        End If
    End If
Next i
If j Then
    Sheet2.Range("A6:E1000").ClearContents
    Sheet2.Range("A6").Resize(j, 5) = dArr
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Rất cảm ơn Bạn đã giúp đỡ.
Bài đã được tự động gộp:

giaiphap đã viết:
2 ý tưởng trùng nhau.
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn đã quan tâm.
Bài đã được tự động gộp:

Rất xin lỗi các Bạn vì gửi nhầm file ( MÌnh cũng đã kiểm tra file khi gửi - nhưng lại gửi nhầm). Mong các Bạn thông cảm và giúp lại mình lần nữa. Rất cảm ơn các Bạn.
 

File đính kèm

Upvote 0
Nhờ các Bạn giúp hộ mình file trên. Xin cảm ơn
 
Upvote 0
huongmuine đã viết:
Nhờ các Bạn giúp hộ mình file trên. Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Xem file đính kèm nhe
Mã: 
Sub Loc()
Dim sArr(), sArr2(), sArr3(), dArr(), i As Long, j As Long, k As Long
sArr = Sheet1.Range("B9:D" & Sheet1.Range("B65535").End(3).Row).Value
sArr2 = Sheet3.Range("B2:C" & Sheet3.Range("B65535").End(3).Row).Value
sArr3 = Sheet2.Range("D5:" & Sheet2.Range("D5").End(xlToRight).Address(0, 0)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 3) <> "" Then
        j = j + 1
        dArr(j, 1) = j
        dArr(j, 2) = sArr(i, 1)
        For k = 1 To UBound(sArr2, 1)
            If Replace(sArr(i, 3), "X-", "") = sArr2(k, 1) Then
                If InStr(sArr(i, 3), "X-") Then
                    dArr(j, k + 3) = "x"
                    dArr(j, 13) = "x"
                Else
                    dArr(j, k + 3) = "x"
                End If
            End If
        Next k
    End If
Next i
If j Then
    Sheet2.Range("A6:M1000").ClearContents
    Sheet2.Range("A6").Resize(j, 13) = dArr
End If
End Sub
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Xem file đính kèm nhe
Mã: 
Sub Loc()
Dim sArr(), sArr2(), sArr3(), dArr(), i As Long, j As Long, k As Long
sArr = Sheet1.Range("B9:D" & Sheet1.Range("B65535").End(3).Row).Value
sArr2 = Sheet3.Range("B2:C" & Sheet3.Range("B65535").End(3).Row).Value
sArr3 = Sheet2.Range("D5:" & Sheet2.Range("D5").End(xlToRight).Address(0, 0)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
For i = 1 To UBound(sArr, 1)
    If sArr(i, 3) <> "" Then
        j = j + 1
        dArr(j, 1) = j
        dArr(j, 2) = sArr(i, 1)
        For k = 1 To UBound(sArr2, 1)
            If Replace(sArr(i, 3), "X-", "") = sArr2(k, 1) Then
                If InStr(sArr(i, 3), "X-") Then
                    dArr(j, k + 3) = "x"
                    dArr(j, 13) = "x"
                Else
                    dArr(j, k + 3) = "x"
                End If
            End If
        Next k
    End If
Next i
If j Then
    Sheet2.Range("A6:M1000").ClearContents
    Sheet2.Range("A6").Resize(j, 13) = dArr
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Xin cảm ơn Bạn đã nhiệt tình giúp đỡ. Kết quả đúng như mình mong đợi.
Chúc Bạn cuối ngày nhiều niềm vui.
 
Upvote 0
Thêm một cách dùng "dao mỗ trâu".
PHP: 
Public Sub Gpe()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Tmp As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheets("Ma").Range("B2:B9").Value
    For I = 1 To 8
        Dic.Item(sArr(I, 1)) = I + 3
    Next I
sArr = Sheets("Data").Range("B9", Sheets("Data").Range("B9").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 13)
    For I = 1 To R
        If sArr(I, 3) <> Empty Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 1)
            If Left(sArr(I, 3), 2) = "X-" Then
                Tmp = Mid(sArr(I, 3), 3)
                dArr(K, 13) = "x"
            Else
                Tmp = sArr(I, 3)
            End If
            dArr(K, Dic.Item(Tmp)) = "x"
        End If
    Next I
Sheets("Loc").Range("A6").Resize(K, 13) = dArr
Set Dic = Nothing
End Sub
 
Upvote 0
Ba Tê đã viết:
Thêm một cách dùng "dao mỗ trâu".
PHP: 
Public Sub Gpe()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Tmp As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheets("Ma").Range("B2:B9").Value
    For I = 1 To 8
        Dic.Item(sArr(I, 1)) = I + 3
    Next I
sArr = Sheets("Data").Range("B9", Sheets("Data").Range("B9").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 13)
    For I = 1 To R
        If sArr(I, 3) <> Empty Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 1)
            If Left(sArr(I, 3), 2) = "X-" Then
                Tmp = Mid(sArr(I, 3), 3)
                dArr(K, 13) = "x"
            Else
                Tmp = sArr(I, 3)
            End If
            dArr(K, Dic.Item(Tmp)) = "x"
        End If
    Next I
Sheets("Loc").Range("A6").Resize(K, 13) = dArr
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Rất cảm ơn Thầy đã giúp đỡ!
 
Upvote 0
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

K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
13
khanhvinhdai1
K
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
0
Đọc
122
GPE-Trợ Lý
GPE-Trợ Lý
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
0
Đọc
24
trung_bhxh
T
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
52
Đọc
103K
khanhvinhdai1
K
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
5
Đọc
88
ptm0412
ptm0412
Huyen9
Lỗi không mailings được.
Trả lời
3
Đọc
65
vanle33
vanle33
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
310
Đọc
23K
kunkoi9390
K
K
Có ai giúp mình lấy kết quả xổ số miền nam về file excel
Trả lời
0
Đọc
27
khanhvinhdai1
K
ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
5
Đọc
2K
ptm0412
ptm0412
H
Công thức tìm kết quả
Trả lời
11
Đọc
119
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
78
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
136
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
124
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
127
VetMini
V
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
414
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
559
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
58
Nhattanktnn
Nhattanktnn
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
148
HUONGHCKT
H
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
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom