chutuoc909
Thành viên chính thức


- Tham gia
- 14/7/15
- Bài viết
- 51
- Được thích
- 2
Tuyệt vời bạn HYen17,
Cám ơn bạn rất nhiều,
mình nhờ thêm 1 vấn đề nữa với:
Hiện tại dữ liệu đc lọc và copy như vậy là ok rồi, Giờ mình muốn khi copy bạn copy luôn ngày tháng tương ứng vào 1 cột bên cạnh được không? và hơi phức tạp 1 tí là định dạng ngày tháng là yyyymmdd (không có '/') vậy có được không nhỉ?
bạn có hiểu ý mình không?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KQ(1 To 6000, 1 To 5) As Variant, rng, Visiblecll, CLL As Range, j As Long, k
If Not Intersect(Target, [f2]) Is Nothing Then
Set rng = Range([f6], [f6].End(2))
k = Application.Match(Target, rng, 0)
If TypeName(k) <> "Error" Then
On Error GoTo thoat
Set Visiblecll = rng.Cells(1, k).Resize([a60000].End(3).Row - 5).SpecialCells(2)
If Err Then GoTo thoat
For Each CLL In Visiblecll
j = j + 1
KQ(j, 1) = j
KQ(j, 2) = CLL.Offset(, -k - 4).Value
KQ(j, 3) = CLL.Value
KQ(j, 4) = CLL.Offset(, -k - 3)
KQ(j, 5) = Format(rng.Cells(1, k), "yyyymmdd")
Next
End If
End If
thoat:
Sheet1.[a7:d6000].Clear
On Error GoTo 0
If j Then Sheet1.[a7].Resize(j, 5) = KQ
End Sub
Mình nhờ thêm 1 vấn đề nữa với:
Hiện giờ mình muốn khi copy bạn đem luôn ngày tháng tương ứng vào 1 cột bên cạnh được không? và định dạng ngày tháng là yyyymmdd (không có '/') vậy có được không nhỉ?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [f2]) Is Nothing Then
Dim Rng As Range, sRng As Range, Sh As Worksheet, Rg0 As Range, Cls As Range
Dim MyFormat As String
Dim Rws As Long
Set Sh = ThisWorkbook.Worksheets("Sheet1")
Sh.[b7].CurrentRegion.Offset(1, 1).ClearContents
Rws = [A6].CurrentRegion.Rows.Count
Set Rng = Range([f6], [f6].End(xlToRight))
MyFormat = Rng.NumberFormat
Rng.NumberFormat = "mm/dd/yyyy"
Set sRng = Rng.Find(Format(Target.Value, "MM/dd/yyyy"), , xlValues, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing", , "Tam Biet!"
Else
Set Rg0 = sRng.Offset(1).Resize(Rws).SpecialCells(xlCellTypeConstants, 1)
If Rg0 Is Nothing Then
MsgBox "Khong Só Lieu"
Else
For Each Cls In Rg0
With Sh.Cells(9 + Rws, "B").End(xlUp).Offset(1)
.Value = Cells(Cls.Row, "A").Value
.Offset(, 1).Value = Cls.Value
.Offset(, 2).Value = Format(Target.Value, "yyyymmdd") '<=|'
.Offset(, 3).Value = Cells(Cls.Row, "C").Value
End With
Next Cls
End If
End If
Rng.NumberFormat = MyFormat
Sh.Select
End If
End Sub
Bạn lấy macro này chép đè lên cái cũ nè:
PHP:Option Explicit Set Rg0 = sRng.Offset(1).Resize(Rws).SpecialCells(xlCellTypeConstants, 1) If Rg0 Is Nothing Then MsgBox "Khong Só Lieu"
cái này xóa hết số liệu của cột đó nó lỏio63i bác ơi
Là sao, bạn?
Fương thức đó là chọn ra những ô có số liệu trong cột mà bạn.
[COLOR=#000000][COLOR=#007700]If [/COLOR][COLOR=#0000BB]Rg0 Is Nothing Then
MsgBox [/COLOR][COLOR=#DD0000]"Khong Só Lieu"
chỉ có cách này mới có hi vọng nhìn thấy "Khong Só Lieu" hihià, là nếu như cột của ngày đó mà ko có số liệu, ví dụ như ngày 30 đi, mình xóa hết số liệu
nó báo là "no cell was found"
cái dòng lệnh dưới
Mã:[COLOR=#000000][COLOR=#007700]If [/COLOR][COLOR=#0000BB]Rg0 Is Nothing Then MsgBox [/COLOR][COLOR=#DD0000]"Khong Só Lieu" [/COLOR][/COLOR]
nó không phát huy tác dụng
On Error Resume Next
Set Rg0 = sRng.Offset(1).Resize(Rws).SpecialCells(xlCellTypeConstants, 1)
On Error GoTo 0
If Rg0 Is Nothing Then
MsgBox "Khong Só Lieu"
Else
mọi thứ điều ổn, nhưng mọi phát sinh thêm thì rất ngại viết lại bài?Dear các Bro,
Bài toán giờ thêm 1 ý nữa thế này ạ:
Hiện tại đang lọc những cột nào có dữ liệu thì mới in, nhưng bây giờ em muốn in cả những thằng ko có dữ liệu nhưng in no ra với dữ liệu =0
và chèn thêm 1 cột nữa trong sheet 1 là Create date(tức là ngày hiện tại). các bác xem có ổn không ?
mọi thứ điều ổn, nhưng mọi phát sinh thêm thì rất ngại viết lại bài?
Đồng ý với bác,
nhưng khổ nỗi ý tưởng của Sếp nó cứ xuất hiện liên tục, buộc mình phải theo.
nên mong được sự giúp đỡ của mọi người.![]()
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [f2]) Is Nothing Then
Dim Arr(), Rng As Range, Cls As Range
Dim Rws As Long, J As Long
Dim Ngay As String
With Target
Ngay = CStr(Year(.Value)) & Right("0" & CStr(Month(.Value)), 2) & Right("0" & CStr(Day(.Value)), 2)
End With
For Each Cls In Range([f6], [f6].End(xlToRight))
If Cls.Value = Target.Value Then Exit For
Next Cls
Rws = [A7].CurrentRegion.Rows.Count
Arr() = [A7].Resize(Rws, 3).Value
For J = 1 To UBound(Arr())
If Arr(J, 1) = "" Then Exit For
Arr(J, 2) = Cells(J + 6, Cls.Column).Value
Arr(J, 3) = Ngay
Next J
Sheet1.[b7].Resize(Rws, 3) = Arr()
Sheet1.Select
End If
End Sub
bạn đừng có "pro" "bro".....mấy vị ở đây dị ứng với nó lắm
chứ hiện này với ngày không có số liệu thì nó ra kết quả như thế nào?
Kiểu này thì thuật toán fải thay thôi,