code vba excel หาจำนวนสินค้า เมื่อรหัสสินค้าซ้ำ

[kuaduang]

เมื่อเลือก input ที่ E7 จะได้รหัสสินค้าตามต้องการจำนวนชิ้นใส่เองหรือตั้งใว้ที่ 1 แต่ต้องการเมื่อเลือกรายการสินค้าซ้ำให้ใส่จำนวนเพิ่มให้อัตโนมัติ เปลี่ยน code ตรงไหน

[snasui]

คำตอบคือไม่ทราบครับ

ลองแนบ Code พร้อมไฟล์แนบ ซึ่งมีตัวอย่างข้อมูล ตัวอย่างคำตอบที่ต้องการ เพื่อเพื่อน ๆ จะมีโอกาสได้ทราบครับ

[kuaduang]

โปรแกรมร้านค้า.xlsm

(59.3 KiB) Downloaded 82 times

Code: Select all

Public Sub addNewItem(id As String)
    If id = "" Then Exit Sub
    
    Dim r As Range, f As Range
    Set r = Range("item")
    Set f = r.Find(What:=id, LookAt:=xlWhole, MatchCase:=True)
    
    Dim foundRow As Long
    If f Is Nothing Then
        MsgBox " äÁ辺ª×èÍÊÔ¹¤éÒ " & id, vbCritical, "¢ÒÂ˹éÒÃéÒ¹"
        
        Exit Sub
    End If
    
    foundRow = f.Row
    
   'search current id
    Dim ServiceCurrentID As Range
    Set ServiceCurrentID = Range("ServiceCurrentID")
    Dim foundDupID As Range
    Set foundDupID = ServiceCurrentID.Find(id)
    If Not (foundDupID Is Nothing) Then
        'add only qty
        Sheets("Service Invoice").Range("F" & foundDupID.Row).Value = Sheets("Service Invoice").Range("F" & foundDupID.Row).Value + Sheets("Service Invoice").Range("ServiceInputQty").Value
        Exit Sub
    End If
    
    'copy data to table
    For r1 = 21 To 13 Step -1
        If Not IsEmpty(Sheets("Service Invoice").Range("A" & r1).Value) Then Exit For
    Next
    
    r1 = r1 + 1
    'ÃËÑÊÊÔ¹¤éÒ  ÃÒÂÅÐàÍÕ´  ÃÒ¤Ò  ¨Ó¹Ç¹   ÃÇÁ
    Sheets("Service Invoice").Range("A" & r1).Value = Sheets("DATA_ITEM").Range("B" & foundRow).Value
    'Sheets("Service Invoice").Range("B" & r1).Value = Sheets("DATA_ITEM").Range("C" & foundRow).Value
    'Sheets("Service Invoice").Range("E" & r1).Value = Sheets("DATA_ITEM").Range("D" & foundRow).Value
    Sheets("Service Invoice").Range("F" & r1).Value = Sheets("Service Invoice").Range("ServiceInputQty").Value
    'Sheets("Service Invoice").Range("G" & r1).FormulaR1C1 = " =RC[-2] * RC[-1]"
End Sub[code]

[/code]

[snasui]

ลองปรับ Code ใน Worksheet_Change เป็นตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case "$E$7"
            Call addNewItem(Target.Value)
            Range("E7").Select
            'reset qty after add id
            If Range("G7").Value > 1 Then Range("G7").Value = 1
        Case "$G$7"
            Range("F12").End(xlDown) = Range("G7") '<== Add this line
            If Target.Value < 1 Then Target.Value = 1
        Case Else:
            If Left(Target.Address, 6) = "$F$" Then
                If Target.Row >= 13 And Target.Row <= 22 Then
                    If IsEmpty(Target.Value) Then
                        Range("F" & Target.Row).ClearContents
                    End If
                End If
            End If
        
            'Debug.Print "x " & Target.Address
    End Select
End Sub

[kuaduang]

ปรับแล้วยังเหมือนเดิม

[snasui]

ด้านล่างนี้ ปรับแล้วไม่เหมือนเดิม

[kuaduang]

ที่แก้ไขนั้นก็ดีแล้ว แต่ที่ต้องการคือ เมื่อเลือกชิ่อสินค้าซ้ำ จำนวนสินค้าจะเพิ่มเอง สมมุติซื้อเบียร์ลีโอแคน 1 กระป๋อง ต้องการเพิ่มอีก 1 กระป๋อง
โดยเลือกที่ E7 เป็นชื่อเบียร์ลีโอแคน ส่วนจำนวนจะเพิ่มเองคือ 1 กระป๋อง(อัตโนมัติ เพราะตั้งจำนวนไว้แล้วคือ 1 ) โปรแกรมตั้งไว้จำนวน 1 ทุกชื่อสินค้าเมื่อไม่ระบุจำนวน ใน qty จะเป็น 1 เสมอ ขอขอบคุณที่เพิ่มเติม code ให้

[snasui]

ในโอกาสหน้าก็ควรจะเขียนอธิบายเช่นที่เขียนมานี้ ไม่ใช่ให้เดาเอาเองครับ

ลองปรับ Code เป็นตามด้านล่าง

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case "$E$7"
            Call AddVal
            Range("E7").Select
            'reset qty after add id
            If Range("G7").Value > 1 Then Range("G7").Value = 1
        Case "$G$7"
            If Target.Value < 1 Then Target.Value = 1
        Case Else:
            If Left(Target.Address, 6) = "$F$" Then
                If Target.Row >= 13 And Target.Row <= 22 Then
                    If IsEmpty(Target.Value) Then
                        Range("F" & Target.Row).ClearContents
                    End If
                End If
            End If
            'Debug.Print "x " & Target.Address
    End Select
End Sub

และเพิ่ม Code ตามด้านล่าง

Code: Select all

Sub AddVal()
    Dim i As Integer, rCheck As Range
    Dim rAll As Range, rsAll As Range
    Dim id As String, l As Long
    With Sheets("DATA_ITEM")
        Set rsAll = .Range("C:C")
    End With
    With Sheets("Service Invoice")
        Set rCheck = .Range("E7")
        If Application.CountIf(rsAll, rCheck) > 0 Then
            l = Application.Match(rCheck, rsAll, 0)
            id = Sheets("DATA_ITEM").Range("B" & l)
        Else
            Call addNewItem(rCheck.Value)
        End If
        If Application.CountIf(.Range("A:A"), id) > 0 Then
            i = Application.Match(id, .Range("A:A"), 0)
            .Range("F" & i) = .Range("F" & i) + 1
        Else
            Call addNewItem(rCheck.Value)
        End If
    End With
End Sub

[kuaduang]

ขอขอบพระคุณมากๆ ที่ให้ตรงตามเป้าประสงค์ครับ อีกนิดหนึ่ง เวลาเลือกแถวใน sheet มันล้นไปหนึ่งแถว เช่น เลือกแถว A13-A22 มันจะไปถึง
A23 ด้วย ในโปรแกรมผมลักไก่คือ ตั้งไว้ที่ A13-A21 จะได้ A22 ด้วย ขอคุณมากๆครับ

[snasui]

เช่น เลือกแถว A13-A22 มันจะไปถึง
A23 ด้วย ในโปรแกรมผมลักไก่คือ ตั้งไว้ที่ A13-A21 จะได้ A22 ด้วย

ช่วยแจ้ง Procedure ด้วยครับว่าชื่ออะไร จะได้เข้าถึงข้อมูลได้โดยไวครับ

[kuaduang]

ขอบคุณครับ แจ้งลบไฟล์แนบให้ด้วยครับ

[kuaduang]

code ได้ตามเป้าประสงค์ครับ แต่เวลา เคลียร์บิลไม่ต้องการมัน Errer 13
i = Application.Match(id, .Range("A:A"), 0) ต้องเปลี่ยนตัวใหนด้วยดรับ

[kuaduang]

เวลายกเลิกบิล Run.time error "13:" Type mismatch. ต้องปรับโค๊ดตรงใหนครับ เดิมผมใช้
Range. Service CurrentID ( >=A13,<=A22)

[snasui]

ขอบคุณครับ แจ้งลบไฟล์แนบให้ด้วยครับ

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

เวลายกเลิกบิล Run.time error "13:" Type mismatch. ต้องปรับโค๊ดตรงใหนครับ เดิมผมใช้
Range. Service CurrentID ( >=A13,<=A22)

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

[kuaduang]

จะแนบไฟล์ให้มันใหญ่เกิน เมื่อใส่ code สินค้าซ้ำเปลี่ยนจำนวนสินค้าอัตโนมัติมันใช้ได้ แต่เวลายกเลิกบิล มัน error 8iy[
จาก sheet service เลือกป้อนชื่อสินค้าตามต้องการ E7 จะได้บิลขาย 1 บิล แต่บิลผิดพลาดต้องการยกเลิก กดปุ่มยกเลิก
ตอบ Yes มันจะขึ้น error ครับ

[kuaduang]

แนบ ภาพ 1

[kuaduang]

กดปุ่มยกเลิก

[snasui]

ปรับ Code ที่ Sub CancelBill เป็นตามด้านล่างครับ

Code: Select all

Public Sub CancelBill()
    Application.EnableEvents = False
    Debug.Print "Cancelbill"
    
    If MsgBox("ต้องการยกเลิกบิลที่กำลังทำงานอยู่", vbQuestion + vbYesNo + vbDefaultButton2, "ขายหน้าร้าน") = vbYes Then
        Range("ServiceCurrentID").ClearContents
        Range("ServiceCurrentQty").ClearContents
        Range("ServiceInputID").ClearContents
        Range("$G$24").ClearContents
        Range("ServiceInputID").Select
        
    End If
    Application.EnableEvents = True
End Sub

[kuaduang]

ใช้ได้แล้วครับ ไปต่างจังหวัดเสียหลายวัน แต่มันยังมีปัญหาอยู่อีกนิดหนึ่งครับ เมื่อบันทึกบิลเรียบร้อยแล้ว จะขึ้นบิลใหม่มันไม่ยอมทำงานอีก คือ พอเราจบบิลการขายครั้งหนึ่งมีการบันทึกบิลเก็บเอาไว้ โดยกด บันทึก เป็นอันว่าเสร็จการขาย 1 บิล ตอนนี้ขายต่อ กด ป้อนรหัสลูกค้าเสร็จ ไปเลือกรายการสินค้า กด E7 ปกติ รหัสสินค้า A13 จะขึ้นมาให้ แต่พอใส่ code ที่ให้มามันไม่มีรหัสสินค้า(ไม่ยอมทำงาน) ต้องไปกด ยกเลิกบิลก่อนจึงกลัมมาเลือกรายการสินค้าได้อัก แต่ที่ต้องการคือ เมื่อบันทึกเสร็จเริ่มบิลใหม่ได้เลยโดยไม่ต้องกลับไปยกเลิกบิลอีกครั้ง ครับ

[snasui]

ลองแนบไฟล์ที่ Update ล่าสุดมาดูกันครับ