VBA .FIND โดยให้หาในเซลล์ที่ซ่อนอยู่ด้วยครับ

[DhitiBank]

สวัสดีอาจารย์และเพื่อนๆ ครับ

ผมติดปัญหาในการกำหนดคำสั่ง FIND ให้มองหาค่าในแภวที่ซ่อนอยู่ครับ เนื่องจากชุดข้อมูลมีการใช้ตัวกรองอัตโนมัติด้วย มีวิธีกำหนดอากิวเมนต์ของ FIND ให้สามารถหาได้ไหมครับ

จากตัวอย่างไฟล์แนบ ผมเขียนโค้ดแบบนี้ครับ

Code: Select all

Public Sub Find_Hidden()
    Dim vfndVal As Variant
    Dim rfndRng As Range
    
    vfndVal = ActiveSheet.Range("c1").Value
    Set rfndRng = ActiveSheet.Columns("a:a").Find(what:=vfndVal, LookIn:=xlFormulas, lookat:=xlPart, _
                            searchorder:=xlNext, MatchCase:=False)
    
    If vfndVal = "" Then Exit Sub
    
    If rfndRng Is Nothing Then
        MsgBox "Not found!!!"
        Exit Sub
    Else
        MsgBox "ข้อมูลของคุณอยู่ที่เซลล์ " & rfndRng.Address
    End If
End Sub

ตอนแรกที่ LookIn: กำหนดเป็น xlValues แต่เห็นบางที่บอกให้เปลี่ยนเป็น xlFormulas แล้วจะหาในเซลล์ที่ซ่อนอยู่ด้วย แต่เปลี่ยนแล้วก็ยังหาไม่เจอครับ
จากตัวอย่างไฟล์แนบ ทดลองหา "b" ปรากฏว่าไม่พบ ทั้งๆ ที่อยู่ในเซลล์ A8 แต่ซ่อนอยู่

ขอบคุณมากครับ

[snasui]

การค้นหาด้วยการ Find จะไม่ครอบคลุมกรณีที่มีการซ่อนบรรทัด หากจะค้นหาด้วยหลักการนั้นให้ยกเลิกการซ่อนบรรทัดก่อนแล้วค่อยค้นหา

หรือใช้การเขียนค้นหาแบบอื่น ๆ เช่นตัวอย่างตามด้านล่างครับ

Code: Select all

Public Sub Find_Hidden()
    Dim vfndVal As Variant
    Dim rfndRng As Range
    Dim r As Range
    Dim lRow As Long
    Dim t As String
    
    vfndVal = ActiveSheet.Range("c1").Value
    If vfndVal = "" Then Exit Sub
    lRow = ActiveSheet.UsedRange.Rows.Count
    Set rfndRng = Range("a2:a" & lRow)
    For Each r In rfndRng
        If r = vfndVal Then
           t = t & "," & r.Address(0, 0)
        End If
    Next r
    If t <> "" Then
        MsgBox "Your data found on cells " & Mid(t, 2)
    Else
        MsgBox "Not found"
    End If
End Sub

[DhitiBank]

อ่อ เป็นเช่นนี้เอง ขอบคุณอาจารย์มากครับ ผมจะลองเอาประยุกต์ใช้ดูครับ

[DhitiBank]

อาจารย์ครับ ขอรบกวนอาจารย์อีกครับ

ผมเจอปัญหากับช่วงข้อมูลที่ใช้ autofilter ครับ คือจากตัวอย่างไฟล์จะมี 3 ชีท
1. 7New ใช้สำหรับใส่ข้อมูลสินค้าใหม่ (เฉพาะแถวที่ 6)
2. STK เป็นฐานข้อมูลสินค้าเกี่ยวกับจำนวนสินค้า เข้า ออก คงเหลือ
3. Pro เป็นฐานข้อมูลสินค้าในเรื่องการกำหนดราคา

เวลาใส่ข้อมูลสินค้าตัวใหม่ ในชีท 7New เสร็จแล้วกดเพิ่มสินค้า ข้อมูลสินค้าจะไปอยู่ในตารางชีท STK และชีท Pro โดยเรียงลำดับตามกลุ่มสินค้า และรหัสสินค้า แต่ปัญหาเกิดที่ชีท STK ครับ หลังจากเรียงลำดับและใส่ autofilter แล้ว สินค้ารายการล่างสุดจะไม่รวมอยู่ใน autofilter (เลือกจาก drop down list จะมองไม่เห็น) เป็นมาตั้งแต่แรก ลองใส่ autofilter เองด้วยมือก็แล้ว ก็ไม่หาย ผมควรแก้อย่างไรครับ

โค้ด VBA สำหรับปุ่ม เพิ่มสินค้าใหม่ครับ อยู่ใน module1 (เรียงลำดับอยู่ในบรรทัด 155 ครับ)

Code: Select all

Private Sub Product_AddNew()
    Dim sH7 As Worksheet, sTK As Worksheet, sPro As Worksheet
    Dim er As Integer, FndVal1 As Integer, FndVal2 As Integer, lstRow As Integer
    Dim pdGrp As Integer, untPck As Integer
    Dim bCode As Variant
    Dim intCd As Long
    Dim fndRng As Range
    Dim untNm As String
    Set sH7 = Sheets("7New")
    Set sTK = Sheets("STK")
    Set sPro = Sheets("Pro")
    intCd = sH7.Range("d6").Value
    bCode = sH7.Range("g6").Value
    er = Application.CountIf(sH7.Range("j3:j8"), "*?")
    
    '-----------------------------------
    'ตรวจสอบว่าพบ error หรือไม่
    '-----------------------------------
    If sH7.Range("b6") = 0 Or intCd = 0 Then
        MsgBox "ใส่รายละเอียดให้ครบก่อน"
        Exit Sub
    End If
    If er > 0 Then
        MsgBox "โปรดแก้ไขข้อผิดพลาด", vbCritical, "ERROR"
        Exit Sub
    End If
    
    '-----------------------------------------------
    'ตรวจรหัสบาร์โค้ด ไม่ให้ซ้ำกับฐานข้อมูลเก่า
    '-----------------------------------------------
    Application.ScreenUpdating = False
    
    FndVal1 = Application.CountIf(sTK.Columns("c:c"), intCd)
    If bCode <> "" Then
        FndVal2 = Application.CountIf(sTK.Columns("M:M"), bCode)
    Else
        FndVal2 = 0
    End If
    
    If FndVal1 + FndVal2 > 0 Then
        MsgBox "ข้อมูลซ้ำ! โปรดตรวจสอบรหัสภายในหรือบาร์โค้ดใหม่", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If

    '-----------------
    'เริ่มใส่ค่าตัวแปร
    '-----------------
    With sH7
        pdGrp = .Range("b6").Value
        untNm = .Range("e6").Value
        untPck = .Range("f6").Value
    End With
    
    '-------------------------------------------------
    'หาแถวสุดท้ายในชีท STK และใส่รายการสินค้า
    '-------------------------------------------------
    With sTK
        .Activate
        .Unprotect
        If .AutoFilterMode Then .AutoFilterMode = False
        lstRow = .Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Row
        .Cells(lstRow, 2).Value = pdGrp
        .Cells(lstRow, 3).Value = intCd
        .Cells(lstRow, 4).Value = untNm
        .Cells(lstRow, 5).Value = untPck
        .Cells(lstRow, 13).Value = bCode
        .Cells(lstRow, 12).NumberFormat = "#,##0.00;[Red]-#,##0.00;0"
        .Cells(lstRow, 13).NumberFormat = "0"
        .Range(Cells(lstRow, 5), Cells(lstRow, 5).Offset(0, 6)).NumberFormat = "#,##0;[Red]-#,##0;"
        .Range(Cells(lstRow, 14), Cells(lstRow, 15)).NumberFormat = "#,##0.00;[Red]-#,##0.00;0"
        .Range(Cells(lstRow, 2), Cells(lstRow, 3)).HorizontalAlignment = xlCenter
        
        '-------------
        'Add formulas
        '-------------
        .Range("v5").Copy
            .Cells(lstRow, 1).PasteSpecial Paste:=xlPasteFormulas
        .Range("w5:ac5").Copy
            .Cells(lstRow, 6).PasteSpecial Paste:=xlPasteFormulas
        .Range("ad5:ak5").Copy
            .Cells(lstRow, 14).PasteSpecial Paste:=xlPasteFormulas
            
        '--------------
        'เปลี่ยน font
        '--------------
        With .Range(Cells(lstRow, 1), Cells(lstRow, 1).Offset(0, 14)).Font
                .Name = "BrowalliaUPC"
                .Size = 14
                .TintAndShade = 0
        End With
        
        '--------
        'ตีกรอบ
        '--------
        With .Range(.Cells(lstRow, "a"), .Cells(lstRow, "o")).Borders
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlHairline
        End With
        
        '//ใส่สีช่องคงเหลือ//
        With .Range(Cells(lstRow, 10), Cells(lstRow, 11)).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 6750207
                .TintAndShade = 0
                .PatternTintAndShade = 0
        End With
        
        '-----------
        'เรียงลำดับ
        '-----------
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("b" & lstRow) _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("c" & lstRow) _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                        .SetRange Range("B5:U" & lstRow)
                        .Header = xlYes
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                End With
                
        If Not .AutoFilterMode Then .Range("a5:u" & lstRow).AutoFilter
        .Protect , AllowFiltering:=True
    End With
    
    '//Add product to pro sheet
    With sPro
        .Activate
        .Unprotect
        .Columns("a:a").EntireRow.Hidden = False
        lstRow = .Range("b" & Rows.Count).End(xlUp).Offset(1, 0).Row
        
        .Cells(lstRow, 1).Value = pdGrp
        .Cells(lstRow, 2).Value = intCd
        .Cells(lstRow, 2).HorizontalAlignment = xlCenter
        .Cells(lstRow, 3).Value = untNm
        .Cells(lstRow, 4).Value = Format(untPck, "#,##0")
        .Cells(lstRow, 6).NumberFormat = "#,##0"
        .Cells(lstRow, 6).Locked = False
        
        With .Range(.Cells(lstRow, 1), .Cells(lstRow, 10)).Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
        
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("a4") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range("b4") _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("a4:j" & lstRow)
                    .Header = xlYes
                    .Orientation = xlTopToBottom
                    .MatchCase = False
                    .Apply
                End With
        Set fndRng = .Columns("b:b").Find(what:=intCd, lookat:=xlWhole)
        fndRng.Offset(0, 4).Select
        .Protect
        .EnableSelection = xlUnlockedCells
    End With
    
    sH7.Range("b6,d6:g6").ClearContents
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "เพิ่มสินค้าใหม่เรียบร้อย"
End Sub

ขอบพระคุณครับ

[snasui]

เป็นปัญหาที่สูตร Subtotal ในคอลัมน์ A แทนที่จะเขียนเป็นสูตรให้เพิ่มค่าด้วย VBA แทน จะทำให้ Filter ได้ทุกรายการครับ

[DhitiBank]

เป็นแบบนี้นี่เอง ขอบคุณมากครับอาจารย์
แต่หากต้องการให้เวลากรองแล้ว ให้เลขในคอลัมน์ A รันตามสินค้าที่แสดงจากการกรอง (เพราะต้องปริ้นท์ออกมานับสต๊อกครับ) ก็ต้องใช้ vba ใส่สูตรลงไปใช่ไหมครับ แทนที่จะสั่งให้คัดลอกสูตรจากที่อื่นมาวาง

(เรื่องใหญ่แล้ว ทำไม่เป็นครับ )

[snasui]

สามารถใช้ VBA เข้ามาช่วยในการให้ลำดับได้ครับ ลองบันทึก Macro หลังจาก Filter โดย

คลุมข้อมูลในคอลัมน์ A > กดแป้น F5 > Special > Visible cells only

เป็นการบันทึก Macro ให้เลือกเฉพาะเซลล์ที่ไม่ได้ซ่อน จากนั้นค่อยนำ Code นั้นมาใช้ต่อโดย Loop เพื่อให้ลำดับรายการดังกล่าวครับ

[DhitiBank]

โอ้.... ขอบพระคุณมากครับ จะลองดูครับ เดี๋ยวจะมารายงานผล

[DhitiBank]

อาจารย์ครับ ลองดูแล้วครับ ติดปัญหาว่าโค้ดทำงานบ้าง ไม่ทำงานบ้างครับ

ผมลองมั่วโค้ดดูตามด้านล่างนี้

Code: Select all

Private Sub Worksheet_Calculate()
    Dim r As Range, rRunNo As Range
    Dim i As Integer
    Set rRunNo = ActiveSheet.Range("A2", Range("a2").End(xlDown)).Cells.SpecialCells(xlCellTypeVisible)

    i = 0
    For Each r In rRunNo
        i = i + 1
        r = i
    Next r

End Sub

ตอนแรกใช้อีเว้นท์ Worksheet_Change() ปรากฏว่านิ่งเลย ก็เลยลองเปลี่ยนเป็น Worksheet_Calculate() โค้ดก็ทำงานเฉพาะเวลาเขียนสูตรใหม่ (ผมใส่สูตร =F1 ไว้ที่เซลล์ E1 ทีแรกใช้สูตร =RAND() ก็เจอปัญหาว่าติดอยู่ในลูป ออกมาไม่ได้) ผมต้องปรับโค้ดอย่างไรดีครับ

ขอบพระคุณครับ

[snasui]

ลองตามนี้ครับ

เซลล์ E1 คีย์สูตร =Today()

จากนั้นปรับ Code เป็นด้านล่าง

Code: Select all

Private Sub Worksheet_Calculate()
    Dim r As Range, rRunNo As Range
    Dim i As Integer
    Application.EnableEvents = False
    With ActiveSheet
        Set rRunNo = .Range("A2", .Range("a2").End(xlDown)) _
            .SpecialCells(xlCellTypeVisible)
    End With
    i = 0
    For Each r In rRunNo
        i = i + 1
        r = i
    Next r
    Application.EnableEvents = True
End Sub

[DhitiBank]

ขอบคุณมากครับอาจารย์ ดึกขนาดนี้ยังตอบให้ ขอบคุณ 1000 ครั้งเลยครับ

[snasui]

ยินดีครับ วันหยุดสามารถนอนดึกได้ครับ

[DhitiBank]

อาจารย์ครับ

ผมจะป้องกันไม่ให้ Procedure อื่นๆ หรือ event ต่างๆ ที่ทำให้เกิดการคำนวณ มาทำให้ Procedure Worksheet_calculate() ทำงานได้อย่างไรครับ เนื่องจากไฟล์ที่ทำอยู่ใส่คำสั่งพวก Worksheet_change() เยอะมาก เนื่องจากข้อมูลเยอะครับและมีหลายชีท ก่อนหน้านี้ใช้แต่สูตรเจอปัญหาคือเสียเวลาคำนวณนานมากๆ กับสูตรที่ต้องทำเผื่อเอาไว้ เลยมาใช้ VBA ช่วย แต่คราวนี้ ไม่ว่าจะรันอะไรก็ตาม มันก็จะเด้งมาที่ Private sub Worksheet_Calculate() ก่อนเลยครับ

ตัวอย่างไฟล์ได้ลบชีทออกไปเกือบครึ่งแล้ว (แต่ละชีทที่ลบมีโค้ด worksheet_change) ส่วน Worksheet_calculate() จะอยู่ที่ชีท STK ครับ

ส่วนพาสเวิร์ดในการปลดล็อคชีทคือ onlyme ครับ (ผมปลดล็อคชีทไว้แล้ว แต่ในโค้ดยังไม่ได้แก้ครับ หากรันแล้วชีทอาจล็อค)

รบกวนอาจารย์อีกแล้ว ขอบคุณมากครับ

[DhitiBank]

ลืมคำถามครับ...

คือผมจะเปลี่ยน Worksheet_Calculate() เป็นอีเว้นท์อย่างอื่นได้ไหมที่ทำให้เมื่อกรองข้อมูลแล้ว อีเว้นท์จะทำงานเหมือนกันครับ

[snasui]

โดยหลักการหากเราไม่ต้องการให้ Event ปัจจุบันไปส่งผลกระทบกับ Event อื่นให้เขียนครอบด้วย

Code: Select all

Application.EnableEvents = False
...
Application.EnableEvents = True

ตามที่อธิบายมาช่วยแจ้งวิธีการทดสอบ ปัญหาที่เป็น ผลลัพธ์ที่ต้องการให้เป็น จะได้ช่วยทดสอบได้ครับ

[DhitiBank]

เช่น ในชีท 2S ครับ จะเป็นส่วนที่ซื้อสินค้าเพื่อออกบิลและตัดสต๊อก
อีเว้นท์ในชีทนี้จะมี 3 ส่วนใหญ่ๆ คือ

1. เมื่อผู้ใช้เลือกคลังสินค้าหรือวันที่ส่งสินค้า (เซลล์ H5) จะสั่งให้ใส่จำนวนสินค้าใหม่ (หากมี) เพื่อจะไปตรวจสอบต่อว่าคลังที่เลือกใหม่ หรือวันที่ส่งที่เลือกใหม่ มีสินค้าพอหรือไม่ครับ

2. เมื่อผู้ใช้ใส่รหัสสินค้า (column E ตั้งแต่แถว 11 ลงไป) โค้ดจะสั่งให้ไปหาข้อมูลสินค้ารหัสนั้นในชีท STK ถ้ามีก็จะแสดงชื่อสินค้า หากไม่มีจะแจ้งให้ทราบเพื่อให้ใส่ข้อมูลสินค้าใหม่ก่อน

3. เมื่อผู้ใช้ใส่จำนวนที่จะเปิดบิล (column F, G, H) โค้ดจะสั่งให้ไปตรวจดูว่า ที่คลังนั้นๆ วันส่งนั้นๆ มีสินค้าคงเหลือในคลังพอหรือไม่ หากพอก็จะคำนวณราคาให้เลยตามที่กำหนดในชีท Pro แต่หากจำนวนไม่พอจะแจ้งให้ทราบครับ

แต่ไม่ว่าจะทำอะไรก็ตาม โค้ดจะวิ่งไปที่ Worksheet_calculate() ที่อยู่ในชีท STK ก่อน แล้วค่อยมาทำงานตามคำสั่งต่อครับ ปัญหาคือ จอมันจะแว้บๆ แล้วก็ตอนที่มีข้อมูลเยอะๆ มันจะช้ามากเลยครับ เป็นลักษณะนี้เช่นเดียวกันกับชีทอื่นด้วยที่มีลักษณะการทำงานเหมือนชีท 2S ครับ

ผมลองใช้ application.enableevents=false แล้ว แต่ดูเหมือนว่าคำสั่ง Worksheet_calculate() จะรันก่อน ค่อยมารัน worksheet_change() ผมเข้าใจถูกไหมครับ

[DhitiBank]

ส่วนหนึ่งก็เป็นเพราะโค้ดที่ผมเขียนด้วยครับ ผมมานั่งดูทีหลังยังรู้สึกว่าน่างงมาก ดูมันสับสนอย่างไรชอบกล เพราะหัวหน้ามาบอกให้เพิ่มนู่นเพิ่มนี่ทีหลัง ผมก็ใส่โน่นแก้นี่จนมันเป็นแบบนี้ พอถึงตอนนี้ผมเลยไม่รู้จะแก้ตรงไหนครับ T_T

[snasui]

ลองปรับ Code เพื่อให้ Event Worksheet_Calculate ทำงานต่อเมื่อชีทปัจจุบันคือชีท STK เท่านั้น หากเป็นชีทอื่นให้ Exit Sub ออกไป ไม่ต้อง List รายการครับ

Code: Select all

Private Sub Worksheet_Calculate()
    Dim imax As Integer, i As Integer
    Dim wSTK As Worksheet
    Dim r As Range, rRunNo As Range
    If ActiveSheet.Name <> "STK" Then Exit Sub
    ...
End Sub

[DhitiBank]

ขอบพระคุณมากครับอาจารย์ สุดยอดเลยครับ
หยุดยาวแบบนี้ อาจารย์ไม่ไปเที่ยวที่ไหนหรือครับ เห็นมาช่วยผู้เดือดร้อนตอบคำถามแต่เช้า

[snasui]

ไม่ได้ไปไหนไกลครับ ผม Online ไม่ทางใดทางหนึงแทบตลอดเวลาครับ