FilterMode = False แต่ Turn on Filtering อยู่ และหา Text กับ Number ใน Column เดียวกัน

[Totem]

เรียนอาจารย์และเพื่อนสมาชิกทุกท่านครับ

ผมใช้ vba Filter แล้วพอปัญหา ดังนี้

1.ใน sheet 1 คอลัมน์ D2 - D3 มีทั้ง Text กับ Number
ใช้ vba Filter แล้วหาค่าได้แล้วแสดงรายการใน Sheet2 เฉพาะ Text แต่ Number ไม่แสดง

Code: Select all

arrList(lngCnt) = cell.Text

ผมลองปรับเป็น

Code: Select all

arrList(lngCnt) = cell.Value

แล้ว
ก็ยังไม่ได้ครับ
2.เมือเข้า FilterMode แล้วหารายการตามที่ต้องการในsheet 1 คอลัมน์ D2 - D3 ได้แล้ว พอ ShowAllData หรือ FilterMode = False หรือ AutoFilterMode = False แต่ Field แถวที่ 1 ก็ยัง Turn on Filtering อยู่
ช่วยปรับแก้ไขให้ด้วยครับ ขอบคุณครับ

Code: Select all

...  .ShowAllData
End With
    FilterMode = False
    AutoFilterMode = False

Code: Select all

Sub Filter()

Dim RngOne As Range, cell As Range
Dim LastColumn, LastCell   As Long
Dim arrList() As String, lngCnt  As Long
Dim Sheet1 As String


With Sheets("Sheet1")

    LastCell = .Range("d" & Sheets("Sheet1").Rows.Count).End(xlUp).Row
    Set RngOne = .Range("d2:d" & LastCell)

End With

lngCnt = 0
For Each cell In RngOne
    ReDim Preserve arrList(lngCnt)
    arrList(lngCnt) = cell.Text
    lngCnt = lngCnt1 + 1
Next

With Sheets("Sheet1")

    LastColumn = .Range("A1").CurrentRegion.Columns.Count
    
    If .FilterMode Then .ShowAllData

    .Range("A1" & LastColumn).AutoFilter Field:=1, Criteria1:=arrList, Operator:=xlFilterValues
    .Range("A1").CurrentRegion.Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy
     Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll
    .ShowAllData
End With

    FilterMode = False
    AutoFilterMode = False

End Sub

Filter.xlsm

[snasui]

แก้ตัวนับใหม่ครับ จาก lngCnt = lngCnt1 + 1 เป็น lngCnt = lngCnt + 1 สังเกตว่ามีการคีย์เลข 1 เกินมา

สำหรับการยกเลิก Filter ให้ปรับ Code เป็นด้านล่างครับ

Code: Select all

'Other code
     Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll
    .ShowAllData
    .AutoFilterMode = False
End With

End Sub

[Totem]

แก้ตัวนับใหม่ครับ จาก lngCnt = lngCnt1 + 1 เป็น lngCnt = lngCnt + 1 สังเกตว่ามีการคีย์เลข 1 เกินมา

สำหรับการยกเลิก Filter ให้ปรับ Code เป็นด้านล่างครับ

Code: Select all

'Other code
     Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteAll
    .ShowAllData
    .AutoFilterMode = False
End With

End Sub

ใช่เลยครับ ผมคีย์ 1 เกินไปไม่เห็นเลยครับตอนแรก ปัญหาข้อ 1 และข้อ 2 ได้ตามต้องการครับ ขอบคุณครับอาจารย์