Giúp code gán dữ liệu vào 1 cell!

[ThuNghi]

Tôi có dữ liệu như sau:
MaKH---SL
A1----1
A2----2
A1----3
A1----4
A12----2
A11----2
Tôi muốn dùng Code theo AdFi và muốn lấy những dữ liệu MaKH=A1, nhưng KQ lại không được mà những MaKH A11, A12 cũng lấy luôn.
Nên tôi dùng tạm code như sau:
...
Range("H1") = "A1"
Range("I2").Formula = "=""=""&R[-1]C[-1]"
With Data
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"I1:I2"), CopyToRange:=Range("A1:F1"), Unique:=False
End With
...
Có cách gì gán thẳng vào
I2: =B1 giống như ta nhập công thức ="="&"B1" hay là ="=B1"
Các bạn giúp hộ cách gán trên trong VBA, khỏi dùng cell phụ là H1, như code tôi làm.
Mục đích là Advance Filter, tạo ra Criteria chính xácm ie chọn A1 thì không có A11
Cám ơn!

 

[ndu96081631]

Tôi có dữ liệu như sau:
MaKH---SL
A1----1
A2----2
A1----3
A1----4
A12----2
A11----2
Tôi muốn dùng Code theo AdFi và muốn lấy những dữ liệu MaKH=A1, nhưng KQ lại không được mà những MaKH A11, A12 cũng lấy luôn.
Nên tôi dùng tạm code như sau:
...
Range("H1") = "A1"
Range("I2").Formula = "=""=""&R[-1]C[-1]"
With Data
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"I1:I2"), CopyToRange:=Range("A1:F1"), Unique:=False
End With
...
Có cách gì gán thẳng vào
I2: =B1 giống như ta nhập công thức ="="&"B1" hay là ="=B1"
Các bạn giúp hộ cách gán trên trong VBA, khỏi dùng cell phụ là H1, như code tôi làm.
Mục đích là Advance Filter, tạo ra Criteria chính xácm ie chọn A1 thì không có A11
Cám ơn!

Đúng là Advanced Filter có cái vụ "te rẹt" quá trớn này!
Sao ThuNghi không dùng AutoFilter nhỉ? Filter xong thì copy Visible cells only? Kết quả cũng giống như Advanced Filter thôi mà

 

[phamduylong]

ThuNghi dùng code này thử xem có đúng yêu cầu không:

Sub MyFilter()
Dim r As Long, rFind As Long, rMkh As Long
Dim Mkh As String
On Error GoTo baoloi
Range(Cells(2, 9), Cells(1000, 10)).ClearContents
rc = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range(Cells(1, 1), Cells(rc, 1)).Select
Mkh = Cells(2, 4)
rMkh = 1
r = 2
Do
  rFind = Selection.Find(What:=Mkh, After:=Cells(rMkh, 1), LookIn:=xlValues,  _
  LookAt:=xlWhole,SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True).Row
  If rFind > rMkh Then
    Cells(r, 9) = Mkh
    Cells(r, 10) = Cells(rFind, 2)
    rMkh = rFind
    r = r + 1
  Else
    Exit Do
  End If
Loop
Exit Sub
baoloi:
MsgBox "Khonng tim thay " & Mkh
End Sub

 

[ThuNghi]

Đúng là Advanced Filter có cái vụ "te rẹt" quá trớn này!
Sao ThuNghi không dùng AutoFilter nhỉ? Filter xong thì copy Visible cells only? Kết quả cũng giống như Advanced Filter thôi mà

1/ Autofilter chỉ giới hạn 10.000 dòng
2/ Nếu có dòng trống, nhiều Autofilter lúc sai
To: Thầy Long
Em muốn dùng Advance Filter vì code của Thầy sẽ duyệt qua từng record thì không thể nào nhanh hơn Advance Filter.

 

[ptm0412]

Range("H1") = "A1"
Range("I2").Formula = "=""=""&R[-1]C[-1]"
With Data
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"I1:I2"), CopyToRange:=Range("A1:F1"), Unique:=False
End With

Có cách gì gán thẳng vào
I2: =B1 giống như ta nhập công thức ="="&"B1" hay là ="=B1"

So sánh code với bài, với file đính kèm (file không có code), chả hiểu gì. Chỗ màu đỏ.
ThuNghi viết bài khó hiểu quá.

 

[ThuNghi]

So sánh code với bài, với file đính kèm (file không có code), chả hiểu gì. Chỗ màu đỏ.
ThuNghi viết bài khó hiểu quá.

Bác khó tính quá, ai cũng hiểu mà, do code là từ file thựcmm còn ví dụ mới tạo ra sau.
Vậy Bác xem hộ em file sau, có code luôn.

Option Explicit
Dim eRow As Long
Dim Data As Range
Sub Loc01()
Sheet1.Select
Range("F1:G10000").Clear
eRow = [A65000].End(xlUp).Row
Range("D2").Value = Range("DMKH").Offset(0, 0).Value
Set Data = Range("A1:B" & eRow)
    With Data
        .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "D1:D2"), CopyToRange:=Range("F1:G1"), Unique:=False
     End With
    ActiveWorkbook.Names("Criteria").Delete
    ActiveWorkbook.Names("Extract").Delete
    eRow = [F65000].End(xlUp).Row
    With Range("F1:G" & eRow).Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
Set Data = Nothing
End Sub
Sub Loc02()
Sheet1.Select
Range("K1:L10000").Clear
eRow = [A65000].End(xlUp).Row
Set Data = Range("A1:B" & eRow)
Range("I1").Value = Range("DMKH").Offset(0, 0).Value
Range("J2").Formula = "=""=""&R[-1]C[-1]"
    With Data
        .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "J1:J2"), CopyToRange:=Range("K1:L1"), Unique:=False
     End With
    ActiveWorkbook.Names("Criteria").Delete
    ActiveWorkbook.Names("Extract").Delete
    eRow = [K65000].End(xlUp).Row
    With Range("K1:L" & eRow).Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
Set Data = Nothing
End Sub

Range("I1").Value = Range("DMKH").Offset(0, 0).Value
Range("J2").Formula = "=""=""&R[-1]C[-1]"
Vấn đề là em muốn rút gọn dòng sau mà vẫn cho đúng đáp án.
La vẫn lọc ra những KH có Mã là A1.

 

[ptm0412]

Vậy thì dễ rồi, cũng như buộc J2 là text (không phải công thức) và gán "=A1" vào ô J2, và "A1" là tuỳ ý khi chọn điều kiện lọc chứ gì?
Thay câu khó hiểu này
Range("J2").Formula = "=""=""&R[-1]C[-1]"
Bằng câu này:
Range("J2") = "'=" & "A1"

(Trước dấu = có 2 dấu nháy: 1 kép 1 đơn)

Muốn tuỳ biến điều kiện lọc thì

Dim dk as String
dk="A2"
 . . .
Range("J2") = "[COLOR=red]'[/COLOR]=" & dk

. . .

 

[cheat]

Vậy thì dễ rồi, cũng như buộc J2 là text (không phải công thức) và gán "=A1" vào ô J2, và "A1" là tuỳ ý khi chọn điều kiện lọc chứ gì?
Thay câu khó hiểu này
Range("J2").Formula = "=""=""&R[-1]C[-1]"
Bằng câu này:
Range("J2") = "'=" & "A1"

(Trước dấu = có 2 dấu nháy: 1 kép 1 đơn)

Muốn tuỳ biến điều kiện lọc thì

Dim dk as String
dk="A2"
 . . .
Range("J2") = "[COLOR=red]'[/COLOR]=" & dk

. . .

dk="A2"
thế này không phải tùy biến rồi
-------------

bình thường thế này thôi, thay 2 dòng đó =1 dòng sau
Range("J2").Value = "'=" & Range("DMKH").Offset(1, 0).Value

vấn đề là bạn cần đặt name cho cell A1 là DMKH - trong file đưa lên chưa có

 

[ThuNghi]

dk="A2"
thế này không phải tùy biến rồi
-------------

bình thường thế này thôi, thay 2 dòng đó =1 dòng sau
Range("J2").Value = "'=" & Range("DMKH").Offset(1, 0).Value

vấn đề là bạn cần đặt name cho cell A1 là DMKH - trong file đưa lên chưa có

Cám ơn Bác Cheat nhiều, hiểu rồi.
Range("J2").Value = "'=" & Range("DMKH").Offset(1, 0).Value
Phải là
Range("J2").Value = "'=" & Range("DMKH").Cells(1, 1).Value
Có vụ này mà không nghĩ ra, "'=" &
Trong file có Range("DMKH") mà, do làm ví dụ nên không lường hết, offset hay cells.
Đây cũng là 1 kinh nghiệm khi dùng code AF.

 

[ptm0412]

dk="A2"
thế này không phải tùy biến rồi

Đặt tên biến, gán giá trị tuỳ ý cho biến, đó chính là tuỳ biến. (đã thí dụ A2 cho khác với A1 rồi)
Cũng như:

Dim i As Long
For i =1 to Range("DMKH").Rows
Range("J2").Value = "'=" & Range("DMKH").[B]Cells[/B](1, [B][COLOR=red]i[/COLOR][/B]).Value
. . .
Next

Có biến i như trên mới là tuỳ biến, không có biến i thì không:

Range("J2").Value = "'=" & Range("DMKH").[B]Cells[/B](1, 1).Value

 

[phamduylong]

1/ Autofilter chỉ giới hạn 10.000 dòng
2/ Nếu có dòng trống, nhiều Autofilter lúc sai
To: Thầy Long
Em muốn dùng Advance Filter vì code của Thầy sẽ duyệt qua từng record thì không thể nào nhanh hơn Advance Filter.

dùng Advance Filter không được vì tìm A1 thì A11, A12, .. nó cũng lôi qua luôn nên phải dùng vòng lặp Do ... Loop
Nhưng trong vòng lặp dùng lệnh Find:

 rFind = Selection.Find(What:=Mkh, After:=Cells(rMkh, 1), LookIn:=xlValues,  _
  LookAt:=xlWhole,SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True).Row

Nên bảng tính có 10.000 nhưng có 100 dữ liệu đúng theo điều kiện tìm thì nó chỉ lặp 100+1 lần.

 

[ThuNghi]

dùng Advance Filter không được vì tìm A1 thì A11, A12,

Sáng giờ em có tham khảo vấn đề trên Anh à.
Dùng
Thêm "'=" & biến (A1, A11, A12 ...) vào trước, lúc này Advance Filter sẽ lấy theo duy nhất A1 hay A11.
Em đã dùng thử trong code Loc2 của file sau.

 

[phamduylong]

Sáng giờ em có tham khảo vấn đề trên Anh à.
Dùng
Thêm "'=" & biến (A1, A11, A12 ...) vào trước, lúc này Advance Filter sẽ lấy theo duy nhất A1 hay A11.
Em đã dùng thử trong code Loc2 của file sau.

Như thế là giải được rồi. Chỉ cần nhập điều kiện lọc vào J2. Việc thêm "'=" để VBA

Sub MyAdvFilter()
Dim Mkh As String, eRow As Long
Range("K1:L1000").Clear
eRow = [A65000].End(xlUp).Row
Mkh = [J2]
[J2] = "'=" & Mkh
Range("A1:B" & eRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[J1:J2], _
            CopyToRange:=Range("K1:L1"), Unique:=False
[J2] = Mkh
End Sub