Page 1 of 1

ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Mon Jul 18, 2022 10:15 am
by 9KiTTi
ขออนุญาตสอบถามวิธีการเขียน code ให้สั้นลง เพราะผมต้องเขียน code รูปแบบนี้กับทุก textbox ขอคำแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub dataload()
        Dim ws As Worksheet
        Dim x As Long
        Set ws = Worksheets("dataload")
        With ws
        ws.Activate
        alldata.ControlSource = "datavalue"
		--------------------ต้องการเขียนให้ code ในส่วนนี้สั้นลงครับ---------------------------------------------
        Me.TextBox1.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!A4:A100000])
        Me.TextBox2.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!B4:B100000])
        Me.TextBox3.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!C4:C100000])
        Me.TextBox4.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!D4:D100000])
        Me.TextBox5.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!E4:E100000])
        Me.TextBox6.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!F4:F100000])
        Me.TextBox7.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!G4:G100000])
        Me.TextBox8.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!H4:H100000])
        Me.TextBox9.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!M4:M100000])
        Me.TextBox10.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!N4:N100000])
        Me.TextBox11.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!O4:O100000])
        Me.TextBox12.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!P4:P100000])
        Me.TextBox13.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!T4:T100000])
        Me.TextBox14.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!U4:U100000])
        Me.TextBox15.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!V4:V100000])
        Me.TextBox16.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!X4:X100000])
        Me.TextBox17.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!Y4:Y100000])
        Me.TextBox18.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!Z4:Z100000])
        Me.TextBox19.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!AA4:AA100000])
        Me.TextBox20.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!AB4:AB100000])
        Me.TextBox21.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!AC4:AC100000])
        Me.TextBox22.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!AD4:AD100000])
        Me.TextBox23.Text = Application.WorksheetFunction.CountA([dataload!A4:A100000]) - _
        Application.WorksheetFunction.CountA([dataload!AE4:AE100000])
		------------------------------------------------------------------------------
               End With
 End Sub

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Mon Jul 18, 2022 1:40 pm
by snasui
:D กรุณาแนบไฟล์ตัวอย่าง ตัดมาเฉพาะที่เกี่ยวกับงานนี้ จะได้สะดวกในการตอบของเพื่อนสมาชิกครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Thu Jul 21, 2022 11:50 am
by 9KiTTi
ไฟล์แนบครับ ในส่วน code ผมเขียนให้แสดงจำนวนข้อมูลทั้งหมดที่ textbox ครับ ตาม code นี้ครับ อยากทราบวิธีที่เขียนให้สั้นลง ขอบพระคุณครับ

Code: Select all

Sub PERSON()
        Dim ws As Worksheet
        Dim x As Long
        Set ws = Worksheets("PERSON")
        With ws
        ws.Activate
        alldata.ControlSource = "F43Import!Q5"
        ----------------------- อยากเขียนให้สั้นลงครับ เพราะต้องเขียนทุกฟอร์มครับ---------------------------
        Me.TextBox1.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!A4:A100000])
        Me.TextBox2.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!C4:C100000])
        Me.TextBox3.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!E4:E100000])
        Me.TextBox4.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!F4:F100000])
        Me.TextBox5.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!G4:G100000])
        Me.TextBox6.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!H4:H100000])
        Me.TextBox7.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!J4:J100000])
        Me.TextBox8.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!O4:O100000])
        Me.TextBox9.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!AD4:AD100000])
        Me.TextBox10.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
        Application.WorksheetFunction.CountA([PERSON!AE4:AE100000])
        -----------------------------------------------------------------------------------------------------------------------
End With
 End Sub

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Thu Jul 21, 2022 12:16 pm
by snasui
:D ตัวอย่างการปรับ Code ให้ Dynamic ลองประยุกต์ใช้ดูครับ

Code: Select all

Sub PERSON()
    Dim ws As Worksheet
    Dim x As Long, i As Integer, r As Range
    Set ws = Worksheets("PERSON")
    With ws
            ws.Activate
            alldata.ControlSource = "F43Import!Q5"
            x = Application.CountA(.Range("a4:a10000"))
            For Each r In .Range("c4,e4,f4,g4,h4,o4,ad4,ae4")
                i = i + 1
                Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(10000))
            Next r
'            x = Application.WorksheetFunction.CountA([PERSON!A4:A100000])
'            Me.TextBox1.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!A4:A100000])
'            Me.TextBox2.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!C4:C100000])
'            Me.TextBox3.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!E4:E100000])
'            Me.TextBox4.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!F4:F100000])
'            Me.TextBox5.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!G4:G100000])
'            Me.TextBox6.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!H4:H100000])
'            Me.TextBox7.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!J4:J100000])
'            Me.TextBox8.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!O4:O100000])
'            Me.TextBox9.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!AD4:AD100000])
'            Me.TextBox10.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!AE4:AE100000])
    End With
End Sub

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Thu Jul 21, 2022 12:56 pm
by 9KiTTi
snasui wrote: Thu Jul 21, 2022 12:16 pm :D ตัวอย่างการปรับ Code ให้ Dynamic ลองประยุกต์ใช้ดูครับ

Code: Select all

Sub PERSON()
    Dim ws As Worksheet
    Dim x As Long, i As Integer, r As Range
    Set ws = Worksheets("PERSON")
    With ws
            ws.Activate
            alldata.ControlSource = "F43Import!Q5"
            x = Application.CountA(.Range("a4:a10000"))
            For Each r In .Range("c4,e4,f4,g4,h4,o4,ad4,ae4")
                i = i + 1
                Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(10000))
            Next r
'            x = Application.WorksheetFunction.CountA([PERSON!A4:A100000])
'            Me.TextBox1.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!A4:A100000])
'            Me.TextBox2.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!C4:C100000])
'            Me.TextBox3.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!E4:E100000])
'            Me.TextBox4.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!F4:F100000])
'            Me.TextBox5.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!G4:G100000])
'            Me.TextBox6.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!H4:H100000])
'            Me.TextBox7.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!J4:J100000])
'            Me.TextBox8.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!O4:O100000])
'            Me.TextBox9.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!AD4:AD100000])
'            Me.TextBox10.Text = Application.WorksheetFunction.CountA([PERSON!A4:A100000]) - _
'            Application.WorksheetFunction.CountA([PERSON!AE4:AE100000])
    End With
End Sub
ทำได้แล้วครับอาจารย์ ขอบพระคุณครับ พอดีไฟล์ที่ทำมันมีขนาดใหญ่มากผิดปกติ ผมไม่แน่ใจว่าเกิดจากอะไร ก็เลยอยากลองแก้ไขไปทีละจุดครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Thu Jul 21, 2022 10:05 pm
by 9KiTTi
หลังจากที่ผมได้ปรับ code อย่างที่อาจารย์แนะนำแล้วสามารถใช้งานได้ครับ แต่ผมพบปัญหาอยู่ 2 ข้อครับ ขออนุญาตรบกวนสอบถามครับ
1.textbox ที่ 11 ไม่แสดงข้อมูลจากการคำนวณหาค่า HN ที่มีจำนวนตัวอักษรน้อยกว่า 5 แต่จำแสดงจำนวนข้อมูลที่มีอยู่ทั้งหมดแทนครับ

Code: Select all

Sub PERSON()
    Dim ws As Worksheet
    Dim x As Long, i As Integer, r As Range
    Set ws = Worksheets("PERSON")
    With ws
            ws.Activate
            alldata.ControlSource = "F43Import!Q5"
            x = Application.CountA(.Range("a4:a100000"))
            For Each r In .Range("a4,c4,e4,f4,g4,i4,j4,o4,ad4,ae4")
                i = i + 1
                Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(100000))
              Me.TextBox11.Text = [counta(H4:H100000)-countif(H4:H100000,rept("?",5)&"*")]
            Next r
End With
 End Sub
2.ปุ่มตรวจสอบในหมวด HN ไม่ทำงานครับ ผมพยายามปรับตามความใจที่มีอันน้อยนิดแล้วก็ไม่ได้

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long
    lr = Range("H" & Rows.Count).End(xlUp).Row
     ActiveSheet.Range("$H$3:$H$100000").AutoFilter Field:=8, Criteria1:= _
        "<?????", Operator:=xlAnd
    Range("H3:H" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
End Sub
ขอความกรุณาแนะนำด้วยครับ ขอบพระคุณครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 7:02 am
by snasui
9KiTTi wrote: Thu Jul 21, 2022 10:05 pm 1.textbox ที่ 11 ไม่แสดงข้อมูลจากการคำนวณหาค่า HN ที่มีจำนวนตัวอักษรน้อยกว่า 5 แต่จำแสดงจำนวนข้อมูลที่มีอยู่ทั้งหมดแทนครับ
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
'              Me.TextBox11.Text = [counta(H4:H100000)-countif(H4:H100000,rept("?",5)&"*")]
              Me.TextBox11.Text = Application.CountA(.Range("h4:h10000")) - _
                Application.CountIfs(.Range("h4:h10000"), "?????*")
'Other code
พยายามฝึกเขียนด้วย Statement ของ VBA แบบทั่ว ๆ ไปที่ไม่อ้างอิงแบบ Shortcut Notation ให้ได้ด้วย เนื่องจากส่วนใหญ่ในการเขียน Code จะไม่เน้นแบบ Shortcut Notation ครับ

ฟังก์ชัน rept ใน VBA จะเขียนเป็น string(5,"?") หมายถึงให้แสดง ? เป็นจำนวน 5 อักขระ
9KiTTi wrote: Thu Jul 21, 2022 10:05 pm 2.ปุ่มตรวจสอบในหมวด HN ไม่ทำงานครับ ผมพยายามปรับตามความใจที่มีอันน้อยนิดแล้วก็ไม่ได้
สำหรับข้อนี้กรุณาอธิบายเพิ่มเติมเพื่อให้เข้าใจตรงกันว่าต้องการจะทำอะไรครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 8:06 am
by 9KiTTi
snasui wrote: Fri Jul 22, 2022 7:02 am
9KiTTi wrote: Thu Jul 21, 2022 10:05 pm 1.textbox ที่ 11 ไม่แสดงข้อมูลจากการคำนวณหาค่า HN ที่มีจำนวนตัวอักษรน้อยกว่า 5 แต่จำแสดงจำนวนข้อมูลที่มีอยู่ทั้งหมดแทนครับ
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
'              Me.TextBox11.Text = [counta(H4:H100000)-countif(H4:H100000,rept("?",5)&"*")]
              Me.TextBox11.Text = Application.CountA(.Range("h4:h10000")) - _
                Application.CountIfs(.Range("h4:h10000"), "?????*")
'Other code
พยายามฝึกเขียนด้วย Statement ของ VBA แบบทั่ว ๆ ไปที่ไม่อ้างอิงแบบ Shortcut Notation ให้ได้ด้วย เนื่องจากส่วนใหญ่ในการเขียน Code จะไม่เน้นแบบ Shortcut Notation ครับ

ฟังก์ชัน rept ใน VBA จะเขียนเป็น string(5,"?") หมายถึงให้แสดง ? เป็นจำนวน 5 อักขระ
9KiTTi wrote: Thu Jul 21, 2022 10:05 pm 2.ปุ่มตรวจสอบในหมวด HN ไม่ทำงานครับ ผมพยายามปรับตามความใจที่มีอันน้อยนิดแล้วก็ไม่ได้
สำหรับข้อนี้กรุณาอธิบายเพิ่มเติมเพื่อให้เข้าใจตรงกันว่าต้องการจะทำอะไรครับ
ตามข้อ 2 ครับ จะเป็นการ filter คอลัมม์ H ให้แสดงจำนวนแถวที่มีค่าตามที่ textbox ที่ 11 คือ จำนวน HN ที่มีจำนวนตัวอักษรน้อยกว่า 5 ตัวอักษรและให้สีใน cell เป็นสีเหลืองครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 8:18 am
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
        If Len(r.Value) < 5 Then
            r.Interior.Color = vbYellow
        End If
    Next r
End Sub

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 2:22 pm
by 9KiTTi
ขอบพระคุณอาจารย์ใช้ได้แล้วครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 8:16 pm
by 9KiTTi
snasui wrote: Fri Jul 22, 2022 8:18 am :D ตัวอย่างการปรับ Code ครับ

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
        If Len(r.Value) < 5 Then
            r.Interior.Color = vbYellow
        End If
    Next r
End Sub
อาจารย์ครับถ้าต้องการให้แสดงเฉพาะข้อมูลที่ต้องตามเงื่อนไข ต้องเขียนใส่ fillter ยังไงครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Fri Jul 22, 2022 8:53 pm
by snasui
:D จะใส่ Filter หรือไม่ก็ได้ เราสามารถซ่อนบรรทัดที่ไม่ตรงตามเงื่อนไขไปด้วย Code ก็ได้เช่นกันครับ

หากต้องการจะใช้ Advanced Filter มาช่วย ลองดูจากตัวอย่างเหล่านี้ครับ :arrow: Adv Filter

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Sun Jul 24, 2022 1:26 pm
by 9KiTTi
ขอสอบถามอาจารย์ต่อครับ หลังจากที่อาจารย์ห้คำแนะนำมา ผมลองไปปรับตามที่อาจารย์แต่ก็ยังแก้ไขไม่ได้ครับ ในส่วนที่ textbox11 ในส่วนของ HN ก็ยังแสดงข้อมูลจำนวนทั้งหมด ไม่แสดงข้อมูลตามเงื่อนไข คือ จำนวนตัวอักษรน้อยกว่า 5 ตัวอักษร
textbox11

Code: Select all

Sub PERSON()
    Dim ws As Worksheet
    Dim x As Long, i As Integer, r As Range
    Set ws = Worksheets("PERSON")
    With ws
            ws.Activate
            alldata.ControlSource = "F43Import!Q5"
            x = Application.CountA(.Range("a4:a100000"))
            For Each r In .Range("a4,c4,e4,f4,g4,i4,j4,o4,ad4,ae4")
                i = i + 1
            Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(100000))
            Me.TextBox11.Text = Application.CountA(.Range("h4:h100000")) - _
                Application.CountIfs(.Range("h4:h100000"), "?????*")
            Next r
End With
 End Sub
ส่วนในปุ่มตรวจสอบของ HN ผมเพิ่ม code เข้าไป แต่ก็ไม่กรองเฉพาะข้อมูลที่มีจำนวนตังอักษรน้อยกว่า 5 ตัวอักษร แต่ใส่สีใน cell ที่มีค่าน้อยกว่า 5 ตัวอํกษรครับ รบกวนอาจารย์แนะนำด้วยครับ

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
    ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8     'บรรทัดที่เพิ่มเข้ามาเพื่อให้แสดงเฉพาะข้อมูลที่ต้องการ
        If Len(r.Value) < 5 Then
          r.Interior.Color = vbYellow
        End If
    Next r
    Range("H4").Activate
End Sub
ขอบพระคุณครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Sun Jul 24, 2022 1:26 pm
by 9KiTTi
ลืมไฟล์แนบครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Sun Jul 24, 2022 4:53 pm
by snasui
:D ตัวอย่างการปรับ Code ลองประยุกต์ใช้ดูครับ

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
'    ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8     'ºÃ÷Ѵ·Õèà¾ÔèÁà¢éÒÁÒà¾×èÍãËéáÊ´§à©¾ÒТéÍÁÙÅ·Õèµéͧ¡ÒÃ
        If Len(r.Value) < 5 Then
          r.Interior.Color = vbYellow
        End If
    Next r
    Range("aj2").Formula = "=len(h4)<5"
    Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Range("aj1:aj2")
    Range("aj2").ClearContents
    Range("H4").Activate
End Sub
ขั้นตอนคือ
  1. เขียนสูตรที่ AJ2 นับจำนวนอักขระใน H4 (เซลล์เริ่มต้นของข้อมูล ไม่รวมหัวคอลัมน์)
  2. Advanced Filter โดยใช้ AJ1:AJ2 เป็น Criteria (AJ1 ต้องเป็นเซลล์ว่างเสมอ)
  3. ล้างค่าใน AJ2

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Mon Jul 25, 2022 1:42 pm
by 9KiTTi
snasui wrote: Sun Jul 24, 2022 4:53 pm :D ตัวอย่างการปรับ Code ลองประยุกต์ใช้ดูครับ

Code: Select all

Private Sub LenHN_Click()
    Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
'    ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8     'ºÃ÷Ѵ·Õèà¾ÔèÁà¢éÒÁÒà¾×èÍãËéáÊ´§à©¾ÒТéÍÁÙÅ·Õèµéͧ¡ÒÃ
        If Len(r.Value) < 5 Then
          r.Interior.Color = vbYellow
        End If
    Next r
    Range("aj2").Formula = "=len(h4)<5"
    Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Range("aj1:aj2")
    Range("aj2").ClearContents
    Range("H4").Activate
End Sub
ขั้นตอนคือ
  1. เขียนสูตรที่ AJ2 นับจำนวนอักขระใน H4 (เซลล์เริ่มต้นของข้อมูล ไม่รวมหัวคอลัมน์)
  2. Advanced Filter โดยใช้ AJ1:AJ2 เป็น Criteria (AJ1 ต้องเป็นเซลล์ว่างเสมอ)
  3. ล้างค่าใน AJ2

ขอบพระคุณครับอาจารย์

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Tue Jul 26, 2022 9:38 am
by 9KiTTi
ไปต่อไม่ได้ครับ รบกวนสอบถามเพิ่มครับ
1.textbox11 ยังแสดงข้อมูลที่มีทั้งหมด ไม่แแสดงข้อมูลตาม code ที่อาจารย์แนะนำมาครับ โดยที่ HN ที่จำนวนตัวอักษรน้อยกว่า 5 มีจำนวน 6 แถว แต่ textbox11 จะแสดงจำนวนข้อมูลแถวที่มีทั้งหมดคือ 20

Code: Select all

Sub PERSON()
    Dim ws As Worksheet
    Dim x As Long, i As Integer, r As Range
    Set ws = Worksheets("PERSON")
    With ws
            ws.Activate
            alldata.ControlSource = "F43Import!Q5"
            x = Application.CountA(.Range("a4:a100000"))
            For Each r In .Range("a4,c4,e4,f4,g4,i4,j4,o4,ad4,ae4")
                i = i + 1
            Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(100000))
            Me.TextBox11.Text = Application.CountA(.Range("h4:h100000")) - _
                Application.CountIfs(.Range("h4:h100000"), "?????*")
             Next r
End With
End Sub
2.กรณีปุ่มตรวจสอบที่ HN สามารถแสดงข้อแถวที่มีข้อมูลตามที่ต้องการได้ครับ แต่ตัว filter หายไปครับ เพราะเมื่อกดปุ่มเคลียร์แล้ว จะไม่แสดงข้อมูลทั้หมดออกมา ผมอยากให้หลังจากแสดงข้อมมูลแล้ว ตัว filter ยังแสดงอยู่ครับ ผมได้เพิ่มบรรทัดให้แสดง filter เข้าไป สามารถแสดงตัว filter ได้ แต่จะแสดงข้อมูลทั้งหมดแทนและแสดง cell สีเหลืองตามเงื่อนไข แต่จะไม่แสดงเฉพาะข้อมูลที่ต้องการคือจำนวน แถวที่มีเลข HN น้อยกว่า 5 ตัวอักษรครับ

Code: Select all

Private Sub LenHN_Click()
     Dim lr As Long, r As Range
    lr = Range("H" & Rows.Count).End(xlUp).Row
    For Each r In ActiveSheet.Range("H3:H" & lr)
        If Len(r.Value) < 5 Then
          r.Interior.Color = vbYellow
        End If
    Next r
    Range("aj2").Formula = "=len(h4)<5"
    Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Range("aj1:aj2")
    ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8 'บรรทัดที่เพิ่มเข้ามาเพื่อให้แสดงตัวกรองทุกคอลลัมม์
    Range("aj2").ClearContents
    Range("H4").Activate
End Sub
รบกวนชี้แนะด้วยครับ เพราะผมเหลือเพียงแค่ 2 ปัญหานี้ก็จะสามารถไปต่อได้แล้วครับ ขอบพระคุณครับ

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Tue Jul 26, 2022 12:34 pm
by snasui
:D คอลัมน์ H ข้อมูลเป็นตัวเลข การนับค่าที่เข้าเงื่อนไขสามารถใช้ขอบเขตล่าง ขอบเขตบนได้ แต่หากเป็น Text จึงควรจะใช้จำนวนอักขระเข้ามาช่วยครับ

ตัวอย่างการปรับ Code พร้อมกับการทำ AutoFilter ตามด้านล่างครับ

Code: Select all

'Other code
With ws
    ws.Activate
    alldata.ControlSource = "F43Import!Q5"
    x = Application.CountA(.Range("a4:a100000"))
    For Each r In .Range("a4,c4,e4,f4,g4,i4,j4,o4,ad4,ae4")
        i = i + 1
        Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(100000))
    Next r
    Me.TextBox11.Text = Application.CountIfs(.Range("h4:h100000"), ">0", .Range("h4:h100000"), "<10000")
    .Range("a3").CurrentRegion.AutoFilter Field:=8, Criteria1:="<10000"
End With
'Other code

Re: ขออนุญาตสอบถามการเขียน Code ให้สั้นลง

Posted: Tue Jul 26, 2022 2:26 pm
by 9KiTTi
snasui wrote: Tue Jul 26, 2022 12:34 pm :D คอลัมน์ H ข้อมูลเป็นตัวเลข การนับค่าที่เข้าเงื่อนไขสามารถใช้ขอบเขตล่าง ขอบเขตบนได้ แต่หากเป็น Text จึงควรจะใช้จำนวนอักขระเข้ามาช่วยครับ

ตัวอย่างการปรับ Code พร้อมกับการทำ AutoFilter ตามด้านล่างครับ

Code: Select all

'Other code
With ws
    ws.Activate
    alldata.ControlSource = "F43Import!Q5"
    x = Application.CountA(.Range("a4:a100000"))
    For Each r In .Range("a4,c4,e4,f4,g4,i4,j4,o4,ad4,ae4")
        i = i + 1
        Me.Controls("TextBox" & i).Text = x - Application.CountA(r.Resize(100000))
    Next r
    Me.TextBox11.Text = Application.CountIfs(.Range("h4:h100000"), ">0", .Range("h4:h100000"), "<10000")
    .Range("a3").CurrentRegion.AutoFilter Field:=8, Criteria1:="<10000"
End With
'Other code
แก้ไขได้แล้วครับอาจารย์ ได้ความรู้เพิ่มขึ้นมากเลยครับ ขอบพระคุณครับอาจารย์