บันทึกข้อมูล

[Benmore]

ขอสอบถามค่ะ ทำไมเมื่อเอาโค้ดที่เหมือนกันมาใส่ในอีกไฟล์นึงที่มีรูปแบบเหมือนกันถึงรันไม่ขึ้นทั้งที่อีกไฟล์รันได้

Untitled.png

ขึ้นแบบนี้ค่ะ

[snasui]

ต้องมีข้อมูลเหมือนกันด้วยจึงจะทำงานได้ครับ

Code นั้นเป็นการใช้ฟังก์ชั่น Match ซึ่งหากไม่พบข้อมูลก็จะเกิด Error ปกติก่อนที่จะ Match เราควรจะนับเสียก่อนว่ามีหรือไม่มีเช่นใช้ Countif หากมีแล้วค่อย Match อีกที ถ้าไม่มีก็ให้ออกจากคำสั่งไป เช่นนี้เป็นต้นครับ

[Benmore]

Code: Select all

Private Sub CommandButton6_Click()
'On Error Resume Next
 Dim id As String
        Dim rowselect As String
        If TextBox7.Text = "" Then
        MsgBox ("Please select data")
        Else
        id = TextBox7.Text
          rowselect = WorksheetFunction.CountIf(Worksheets("¡ÒÃàºÔ¡").Range("A2:A10000"), 0)
       rowselect = WorksheetFunction.Match(id, Sheet9.Range("A2:A10000"), 0)
        Rows(rowselect).Select
       Rows(rowselect).EntireRow.Delete
       If MsgBox("Are you sure want to delete to data?", vbYesNo) = vbYes Then
     Unload Me
    End If
            End If
        Unload Me
        Requisition.Show
End Sub

ลองแก้แล้วก็ทำไม่ได้ค่ะ

[snasui]

การใช้ Counif ตามที่โพสต์มาเขียนไม่ถูกต้อง และแม้จะเขียนถูกต้องก็ไม่ได้ช่วยให้ Code ทำงานได้ตามที่ควรจะเป็นเพราะไม่ได้ใช้ประโยชน์จาก Countif แต่ประการใด

จากบรรทัดนี้

rowselect = WorksheetFunction.CountIf(Worksheets("¡ÒÃàºÔ¡").Range("A2:A10000"), 0) เปลี่ยนเป็น

rowselect = WorksheetFunction.CountIf(Worksheets("¡ÒÃàºÔ¡").Range("A2:A10000"), id)

จากนั้นนำผลลัพธ์ไปใช้ในการตัดสินใจ ตัวอย่างเช่นด้านล่างครับ

Code: Select all

If rowselect = 0 then
   exit sub
else
   ' rowselect = worksheetfunction.match(...)
end if
'Other code

เป็นการนับ id เสียก่อนว่ามีหรือไม่ หากมีแล้วค่อย Match ต่อไป ส่วนของอักขระ ... ใน Match เป็นการละไว้ในฐานที่เข้าใจครับ

[Benmore]

Code: Select all

Private Sub CommandButton6_Click()
'On Error Resume Next
        If TextBox7.Text = "" Then
        MsgBox ("Please select data")
              Exit Sub
        Else
        Dim id As String
        Dim rowselect As String
         id = TextBox7.Text
   rowselect = WorksheetFunction.CountIf(Worksheets("การเบิก").Range("A1:A10000"), id)
        If rowselect = 0 Then
   Exit Sub
Else
rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A10000"), id)
        Rows(rowselect).Select
       Rows(rowselect).EntireRow.Delete
       End If
       If MsgBox("Are you sure want to delete to data?", vbYesNo) = vbYes Then
       Else
       UserForm1.Show
     Unload Me
    End If
        End If
        Unload Me
        UserForm1.Show
End Sub

ลองนำโค้ดไปแก้ไขแล้วยังติด error ที่บรรทัดนี้ค่ะ

Code: Select all

rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A10000"), id)

แต่ถ้าเอาบรรทัดนี้ออกก็จะไม่ error แต่ไม่ลบข้อมูลที่เราเลือกแต่จะลบข้อมูลที่บรรทัดแรกค่ะ
รบกวนดูโค้ดตรง

Code: Select all

If MsgBox("Are you sure want to delete to data?", vbYesNo) = vbYes Then
       Else
       UserForm1.Show
     Unload Me
    End If

ให้ด้วยค่ะ ถ้ากด No แล้วก็ยังมีการลบข้อมูลเหมือนกับกด Yes เลยค่ะ

[snasui]

แก้ไขให้ผ่านไปทีละเปลาะครับ

จาก Code ที่เขียนมาเป็นการนำค่าใน TextBox7 ไปหาในคอลัมน์ A ของ Sheet9 หากไม่มีค่านั้นก็จะเกิด Error นอกจากนี้ ก่อนที่จะ Match ก็ต้องทำการตรวจสอบค่าใน TextBox7 เสียก่อนว่ามีอยู่ในคอลัมน์ A ของ Sheet9 หรือไม่ หากมีแล้วค่อย Match ครับ

Statement ที่ถูกของตัวแปร rowselect คือด้านล่างครับ

rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A10000"), 0)

ลองปรับมาใหม่พร้อมทั้งใช้ Countif เข้าไปช่วย ดูตัวอย่างในโพสต์ #44 ประกอบครับ

[Benmore]

Code: Select all

Private Sub CommandButton6_Click()
'On Error Resume Next
        If TextBox7.Text = "" Then
        MsgBox ("Please select data")
              Exit Sub
        Else
        Dim id As String
        Dim rowselect As String
        If id = TextBox7.Text Then
         Exit Sub
Else
   rowselect = WorksheetFunction.CountIf(Worksheets("การเบิก").Range("A1:A10000"), id)
    End If
        If rowselect = 0 Then
   Exit Sub
Else
rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A10000"), 0)
        Rows(rowselect).Select
       Rows(rowselect).EntireRow.Delete
       End If
       If MsgBox("Are you sure want to delete to data?", vbYesNo) = vbYes Then
     Unload Me
    End If
        End If
        Unload Me
        Requisition.Show
End Sub

ปรับได้ตามนี้แต่ก็ยังรันไม่ได้ค่ะ ต้องปรับตรงไหนเพิ่มค่ะ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
Dim id As String
Dim rowselect As Long
If TextBox7.Text = "" Then
    MsgBox ("Please select data")
    Exit Sub
Else
    id = Me.TextBox7.Text
    If WorksheetFunction.CountI(Sheet9.Range("A1:A10000"), id) > 0 Then
       rowselect = WorksheetFunction.Match(CLng(id), Sheet9.Range("A1:A10000"), 0)
    Else
        Exit Sub
    End If
    Rows(rowselect).EntireRow.Delete
   'Other code
End If
'Other code

กรณีมีการปรับ Code ใหม่ควรแนบไฟล์ล่าสุดที่ได้ปรับ Code ไปแล้วมาด้วย อย่าลืมพิจาณาตัดส่วนที่ไม่เกี่ยวข้องเช่น UserForm อื่น ๆ Code อื่น ๆ ที่ไม่เกี่ยวข้องทิ้งไป จะได้เข้าถึงข้อมูลโดยไว ซึ่งจะเป็นประโยชน์กับคุณ Benmore เอง เพราะผู้ตอบบางคนเช่นตัวผมจะมีเวลาจำกัดและพยายามใช้เวลาให้น้อยที่สุดในแต่ละกระทู้ ต้องขออภัยในความไม่สะดวกครับ

[Benmore]

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

Code: Select all

Private Sub CommandButton6_Click()
'On Error Resume Next
Dim id As String
Dim rowselect As Long
If TextBox7.Text = "" Then
    MsgBox ("Please select data")
    Exit Sub
Else
 id = Me.TextBox7.Text
    If WorksheetFunction.CountIf(Sheet9.Range("A1:A10000"), id) > 0 Then
       rowselect = WorksheetFunction.Match(CLng(id), Sheet9.Range("A1:A10000"), 0)
    Else
        Exit Sub
End If
   Rows(rowselect).EntireRow.Delete
   rowselect = WorksheetFunction.CountIf(Worksheets("¡ÒÃàºÔ¡").Range("A1:A10000"), id)
        If rowselect = 0 Then
   Exit Sub
Else
rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A10000"), 0)
        Rows(rowselect).Select
       Rows(rowselect).EntireRow.Delete
End If
       If MsgBox("Are you sure want to delete to data?", vbYesNo) = vbYes Then
       Unload Me
        UserForm1.Show
    End If
    End If
End Sub

[snasui]

ย้าย Code การถามไปไว้ด้านบน สามารถนำไปวางบนสุดหลังประกาศตัวแปรก็สามารถทำได้

ควรทดลอง Debug ด้วยการ Run ทีละ Step ก็จะทราบได้เองว่าควรวางไว้ตรงไหน อย่างไร งานลักษณะนี้ไม่ได้ยากเกินไปครับ

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

[Benmore]

ได้แล้วค่ะ รบกวนดูโค้ดให้หน่อยค่ะว่าทำไมตอนรันโปรแรมถึงประมวลผลช้าค่ะ

Uniform_EGAS(Ex).zip

[snasui]

จำเป็นต้องอธิบายพร้อมยกตัวอย่างมาให้ชัดเจน กำลังทำงานไหน ข้อมูลทดสอบคืออะไร ลำดับการทำงานเป็นอย่างไร ช้าในขั้นตอนใด ผมพบว่าต้องแจ้งข้อมูลในลักษณะนี้บ่อยครั้ง ช่วยแจ้งมาด้วยเสมอ ๆ ครับ

[Benmore]

ตอนกดปุ่ม save , Delete ค่ะ ปัญหาที่ Userform1 ค่ะ
พอเลือกข้อมูลเรียบร้อยแล้ว กดปุ่ม save ต้องรอให้รันอีกนานเลยค่ะจนกว่าจะบันทึกได้
ปุ่มลบก็เช่นกันค่ะ เมื่อเลือกข้อมูลที่ต้องการลบแล้วกดปุ่ม Delete แล้วก็ต้องรอนานเหมือนกันกว่าจะลบสำเร็จค่ะ

[snasui]

ช้าเพราะสูตรในชีตการเบิกมีจำนวนมากครับ

สามารถปรับการคำนวณเป็น Manual ไปเสียก่อนด้วย Code เมื่อ Run เสร็จแล้วก่อน End Sub ให้ปรับการคำนวณกลับมาเป็น Automatic ดังตัวอย่างด้านล่างครับ

Application.Calculation = xlCalculationManual
'Other code ...
Application.Calculation = xlCalculationAutomatic

[Benmore]

ตรงนี้ทำได้แล้ว ขอบคุณค่ะ
รบกวนถามต่อค่ะ
ช่วยดูโค้ดที่แนบมาให้หน่อยค่ะ Userform3
ถ้าอยากให้เลือกข้อมูลใน combobox1 กับ combobox2 แล้วแสดงข้อมูลคงเหลือจากชีท 2 ตามหัวข้อที่เลือกต้องแก้ไขตรงไหนเพิ่มค่ะ

Code: Select all

Private Sub btsearch_Click()
'On Error Resume Next
If ComboBox1 = "" Or ComboBox2 = "" Then
             MsgBox "Please fill the complete data"
        Exit Sub
    End If
   Dim found As Boolean
   Dim txt As String
   Dim r As Range
    Dim nRow As String
    Sheet4.Activate
    For Each r In Sheet4.Columns(1).SpecialCells(xlCellTypeConstants)
      'If Right(r.Value, 3) = Right(ComboBox1.Text, 3) And
      If ComboBox2.Text = Application.Text(r.Offset(0, 1).Value, ComboBox2.Text) Then
    nRow = r.Row
    found = True
    Exit For
End If
    Next r
    If found Then
    txt = Cells(nRow, 6)
 TextBox1.Text = txt
     Exit Sub
     Else
 MsgBox "Data not found !"
    End If
    'Sheet1.Activate
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
For Each r In Sheet4.Columns(2).SpecialCells(xlCellTypeConstants)
    'If Right(r.Value, 3) = Right(ComboBox1.Text, 3) And
'        If ComboBox2.Text = Application.Text(r.Offset(0, 1).Value, ComboBox2.Text) Then
    If (r.Value = ComboBox2.Text And r.Offset(0, -1).Value = ComboBox1.Text) Or _
        r.Value = ComboBox2.Text And r.Offset(0, -1).End(xlUp).Value = ComboBox1.Text Then
'            r.Value = comb
        nRow = r.Row
        found = True
        Exit For
    End If
Next r
'Other code