Giúp rút trích dử liệu bằng công thức (1 người xem)
- Thread starter quancui
- Ngày gửi
Người dùng đang xem chủ đề này
bebo021999
Thành viên gạo cội
- Tham gia
- 26/1/11
- Bài viết
- 6,041
- Được thích
- 8,810
- Giới tính
- Nam
- Nghề nghiệp
- GPE
Nếu bạn đánh dấu "x" hay gì đó ở 1 cột phụ thì công thức làm được, còn tô màu thế này thì chờ các sư phụ VBA vậy
Không biết có cách nào làm để không sử dụng VBA không bạn, chứ VBA mình chẳng biết gì hết. Rồi mất công gỡi báo cáo đi máy khác lại không hiểu thì khổ.
Phần điều kiện của mình như sau:
1. Ở dòng DR
+ Giá trị giữa 3 ~ 5 thì hiển thị chử màu đỏ.
+ Giá trị lớn hơn 6 thì cho chử màu đỏ và nền màu hồng (nhưng vì giá trị của mình không lớn hơn 100 được nên mình làm giữa 6 ~100 luôn)
2. Ở dòng BT
+ Giá trị giữa 2 ~ 3 thì cho chử màu đỏ
+ Giá trị lớn hơn 4 thì cho chử đỏ và nền hồng. (mình làm giữa 4 ~ 100)
3. Ở dòng A/C
+ Giá trị giữa 2 ~ 3 thì cho chử màu đỏ
+ Giá trị lớn hơn 4 thì cho chử đỏ nền hồng. (mình làm giữa 4 ~ 100)
4. Ở dòng Tổng
+ Giá trị giữa 3 ~ 5 thì cho chử màu đỏ
+ Giá trị lớn hơn 6 thì cho chử đỏ và nền hồng. (mình làm giữa 6 ~ 100)
Điều kiện của em là như thế, mong tiền bối giúp đỡ.
Em cảm ơn!
hungpecc1
Thành viên gắn bó
- Tham gia
- 24/8/12
- Bài viết
- 1,709
- Được thích
- 2,304
- Giới tính
- Nam
Đọc bài này từ trưa, mà chưa thấy ai trả lời giúp bạn !
Vừa đi liên hoan về, ( ^^ hơi phê volka ) , mình viết đại 1 đoạn code ( hơi rườm rà tẹo
) bạn xem thử có ổn không ( nếu đc các pác trong GPE sẽ giúp bạn sửa và bổ sung thêm 1 số vấn đề nữa ^^ )Bạn xem file đính kèm nhé ( nhập ngày và click vào nút ok )
còn việc "Không biết có cách nào làm để không sử dụng VBA không bạn, chứ VBA mình chẳng biết gì hết. Rồi mất công gỡi báo cáo đi máy khác lại không hiểu thì khổ."
Bạn xem thử file đính kèm có chỗ nào không hiểu và khó sử dụng không ?
Mã:
Sub Rut_trich_du_lieu()
Dim Arr(), mycell As Range, rng As Range, rng1 As Range
Dim n As Long, ngay As Integer, vtri As Long
On Error Resume Next
ngay = Range("AN24").Value
vtri = WorksheetFunction.Match(ngay, Range("A1:AJ1"), 0)
Set rng1 = Range("A:A").Offset(, vtri - 1)
ReDim Arr(1 To Range("F65536").End(xlUp).Row, 1 To 5)
Set rng = Range("E:E").Resize(Range("E65536").End(xlUp).Row)
For Each mycell In rng
If mycell.Value = "DR" And rng1.Cells(mycell.Row) >= 3 _
And rng1.Cells(mycell.Row) <= 5 Then
n = n + 1
Arr(n, 5) = rng1.Cells(mycell.Row)
Arr(n, 4) = "DR"
Arr(n, 3) = Range("D:D").Cells(mycell.Row)
End If
If mycell.Value = "BT" And rng1.Cells(mycell.Row) >= 2 _
And rng1.Cells(mycell.Row) <= 3 Then
n = n + 1
Arr(n, 5) = rng1.Cells(mycell.Row)
Arr(n, 4) = "BT"
Arr(n, 3) = Range("D:D").Cells(mycell.Row - 1)
End If
If Trim(mycell.Value) = "A/C" And rng1.Cells(mycell.Row) >= 2 _
And rng1.Cells(mycell.Row) <= 3 Then
n = n + 1
Arr(n, 5) = rng1.Cells(mycell.Row)
Arr(n, 3) = Range("D:D").Cells(mycell.Row - 2)
Arr(n, 4) = "A/C"
End If
If Left(mycell.Value, 1) = "T" And rng1.Cells(mycell.Row) >= 3 _
And rng1.Cells(mycell.Row) <= 5 Then
n = n + 1
Arr(n, 5) = rng1.Cells(mycell.Row)
Arr(n, 4) = "Tong"
Arr(n, 3) = Range("D:D").Cells(mycell.Row - 3)
End If
Next
If n Then
Range("AM26").Resize(n, 5).ClearContents
Range("AM26").Resize(n, 5) = Arr
Else
Range("AM26").Resize(1000, 1000).ClearContents
Range("AM26") = "NO DATA "
End If
End SubSay rồi về nhà thôi ^^ Thanks GPE
Lần chỉnh sửa cuối:
Đọc bài này từ trưa, mà chưa thấy ai trả lời giúp bạn !
Vừa đi liên hoan về, ( ^^ hơi phê volka ) , mình viết đại 1 đoạn code ( hơi rườm rà tẹo
Bạn xem file đính kèm nhé ( nhập ngày và click vào nút ok )
còn việc "Không biết có cách nào làm để không sử dụng VBA không bạn, chứ VBA mình chẳng biết gì hết. Rồi mất công gỡi báo cáo đi máy khác lại không hiểu thì khổ."
Bạn xem thử file đính kèm có chỗ nào không hiểu và khó sử dụng không ?
Mã:Sub Rut_trich_du_lieu() Dim Arr(), mycell As Range, rng As Range, rng1 As Range Dim n As Long, ngay As Integer, vtri As Long On Error Resume Next ngay = Range("AN24").Value vtri = WorksheetFunction.Match(ngay, Range("A1:AJ1"), 0) Set rng1 = Range("A:A").Offset(, vtri - 1) ReDim Arr(1 To Range("F65536").End(xlUp).Row, 1 To 5) Set rng = Range("E:E").Resize(Range("E65536").End(xlUp).Row) For Each mycell In rng If mycell.Value = "DR" And rng1.Cells(mycell.Row) >= 3 _ And rng1.Cells(mycell.Row) <= 5 Then n = n + 1 Arr(n, 5) = rng1.Cells(mycell.Row) Arr(n, 4) = "DR" Arr(n, 3) = Range("D:D").Cells(mycell.Row) End If If mycell.Value = "BT" And rng1.Cells(mycell.Row) >= 2 _ And rng1.Cells(mycell.Row) <= 3 Then n = n + 1 Arr(n, 5) = rng1.Cells(mycell.Row) Arr(n, 4) = "BT" Arr(n, 3) = Range("D:D").Cells(mycell.Row - 1) End If If Trim(mycell.Value) = "A/C" And rng1.Cells(mycell.Row) >= 2 _ And rng1.Cells(mycell.Row) <= 3 Then n = n + 1 Arr(n, 5) = rng1.Cells(mycell.Row) Arr(n, 3) = Range("D:D").Cells(mycell.Row - 2) Arr(n, 4) = "A/C" End If If Left(mycell.Value, 1) = "T" And rng1.Cells(mycell.Row) >= 3 _ And rng1.Cells(mycell.Row) <= 5 Then n = n + 1 Arr(n, 5) = rng1.Cells(mycell.Row) Arr(n, 4) = "Tong" Arr(n, 3) = Range("D:D").Cells(mycell.Row - 3) End If Next If n Then Range("AM26").Resize(n, 5).ClearContents Range("AM26").Resize(n, 5) = Arr Else Range("AM26").Resize(1000, 1000).ClearContents Range("AM26") = "NO DATA " End If End Sub
Say rồi về nhà thôi ^^ Thanks GPE
Tiền bối ăn nhậu phê phê rồi mà cũng tạo được vậy không biết là dùng môn kungfu gì đây dạy lại học trò này với chứ học trò này vò đầu bứt tóc nghiệm cái VBA cũng không hiểu chi hết.
Công nhận phải nói: file chạy ổn không giống những VBA lúc trước hậu bối từng mở ra. Sao kỳ vậy nhỉ?
Luôn đây hậu bối xin hỏi là:
1. Dữ liệu của hậu bối nó nối dài xuống phía dưới rất dài, giờ muốn thay đổi vùng dử liệu của nó thì vào đâu vậy tiền bối?
2. Dữ liệu hậu bối muốn lấy ra gồm Cột đầu tiên là Line, cột thứ hai là Beam, hai cột này không rút trích được tiền bối
3. Hậu bối muốn đổi tên sheet và đưa vào file khác thì có được không?
Mong tiền bối chỉ giáo, đệ tử xin thọ giáo.
Bài viết mới nhất
- Question
Nhờ viết code VBA để thống kê các số hay ra cùng nhau
(1 người xem)
- Question
Xuất hiện nội dung gợi ý khi di chuột đến ô dữ liệu
(1 người xem)
- Question
