VBA ต้องการแก้ไขสูตร(ของคนอื่น) เพราะข้อมูลเปลี่ยนตำแหน่ง

[apasri]

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

ขอความช่วยเหลือเรื่องการแก้ไขสูตร VBA ค่ะ

ชีตแรก เป็นการป้อนข้อมูลแบบ drop down และมี ปุ่มคำสั่ง VBA สำหรับโอนย้ายข้อมูลไปชีตอื่นๆ (ชีดสีแดง)

โดยตอนแรกมีข้อมูลจำนวนมาก ต่อมาลดข้อมูลลง ซึ่งต้องการเปลี่ยนตำแหน่งช่องข้อมูลให้กระชับขึ้น (ตามตัวอย่างชีตสีเหลือง)

ปัญหาที่พบเมื่อลบช่องข้อมูลออก ทำให้คำสั่งVBA ทำงานไม่ได้

จึงขอความช่วยเหลือช่วยดูและแก้ไขสูตรให้ด้วยค่ะ

เนื่องจากเจ้าหน้าที่ที่เขียนสูตร VBA ไม่ได้ทำงานที่เดิมแล้ว

ขอขอบคุณมากค่ะ

[snasui]

ไฟล์ที่แนบมาไม่มี Code VBA ครับ

[apasri]

แก้ไขได้แล้วค่ะ แนบไฟล์มาให้ใหม่แล้วนะคะ ชื่อไฟล test44 ค่ะ

[logic]

ลองตัดข้อมูลมาบางส่วน พอเป็นตัวอย่างครับ

[apasri]

จากตัวอย่าง คือ ข้อมูลจากการป้อนด้วยคำสั่งVBA ไปยังชีตและช่องต่างๆ ซึ่งตอนนี้ เราไม่สามารถจัดช่องให้กระชับได้ (ต้องการลบช่องสีเทาที่ไม่ใช้) เพราะการลบช่อง ทำให้ VBA ไม่ทำงาน ซึ่งน่าจะเป็นเพราะ สูตรVBA กำหนดไว้ แต่ไม้่มีใครแก้สูตรเป็น จึงขอรบกวนท่านผู้รู้ที่เววปนี้ค่ะ และ(ไม่ต้องการhide เนื่องจากมีการcopyข้อมูลไปใช้อีกค่ะ) /ขอบคุณล่วงหน้าค่ะ

[snasui]

แก้ไขได้แล้วค่ะ แนบไฟล์มาให้ใหม่แล้วนะคะ ชื่อไฟล test44 ค่ะ

ไฟล์นี้ก็ยังไม่มี Code ต้องแนบไฟล์ที่มี Code จึงจะแก้ Code ให้ได้ครับ

[apasri]

ขออภัยอีกครั้งค่ะ รอบนี้ได้แน่ๆค่ะ

[snasui]

Code ที่จะต้องแก้คือตามด้านล่างครับ

Code: Select all

Sub AutoShape1_Click()    'save input
Dim r As Double, rr As Integer, mc As String
Dim mo As String, pa As String, shift As String, sec As String
If Sheet1.Range("B5") <> "" Then
rr = 5
mo = ""
pa = ""
sec = ""
Do While Sheet1.Cells(rr, 1) <> ""
If Sheet1.Cells(rr, 2) <> "" And sec <> Sheet1.Cells(rr, 2) Then
    SH = check_pro(Sheet1.Cells(rr, 2))
    sec = Sheet1.Cells(rr, 2)
    r = check_row(3)
End If
'=======================================================
    Sheets(SH).Cells(r, 1) = Sheet1.Range("C1")
    Sheets(SH).Cells(r, 2) = Sheet1.Range("D1")
    Sheets(SH).Cells(r, 3) = Sheet1.Range("E1")
    '=================================
    If Sheet1.Cells(rr, 3) <> "" Then
        mo = Sheet1.Cells(rr, 4)
        pa = Sheet1.Cells(rr, 3)
        'mc = Sheet1.Cells(rr, 9)
        'shift = Sheet1.Cells(rr, 7)
    End If
    Sheets(SH).Cells(r, 4) = Sheet1.Cells(rr, 7)  'shift
    Sheets(SH).Cells(r, 5) = mo  ' model
    Sheets(SH).Cells(r, 6) = pa  ' part name
    Sheets(SH).Cells(r, 7) = Sheet1.Cells(rr, 12)  'input
    Sheets(SH).Cells(r, 17) = Sheet1.Cells(rr, 17)  'output
    Sheets(SH).Cells(r, 9) = Sheet1.Cells(rr, 14)   'ng
    Sheets(SH).Cells(r, 10) = Sheet1.Cells(rr, 15)  'ng code
    Sheets(SH).Cells(r, 11) = Sheet1.Cells(rr, 16)  'ng name
    Sheets(SH).Cells(r, 12) = Sheet1.Cells(rr, 17)  'ng amount
    Sheets(SH).Cells(r, 14) = Sheet1.Cells(rr, 8)   'part no.
    Sheets(SH).Cells(r, 15) = Sheet1.Cells(rr, 11)  'inventory
    'Sheets(SH).Cells(r, 16) = Sheet1.Cells(rr, 9)   'MC
    Sheets(SH).Cells(r, 9) = Sheet1.Cells(rr, 9)
    If SH = "DLC" Then
        Sheets(SH).Cells(r, 18) = Sheet1.Cells(rr, 10)   'Opt
    Else
        Sheets(SH).Cells(r, 17) = Sheet1.Cells(rr, 10)   'Opt
    End If
    If SH = "DLC" Then Sheets(SH).Cells(r, 19) = Sheet1.Range("L1")  ' Type
    Sheets(SH).Cells(r, 13) = sec
    r = r + 1
    rr = rr + 1
Loop
End If
'=======================================================
    Sheet1.Range("B5:K1000") = ""
    Sheet1.Range("M5:O1000") = ""
    Sheet1.Range("Q5:Q1000") = ""

End Sub

Sheets(HS) คือชีต Output
Sheets(SH).Cells(r, 4) คือชีต Output เซลล์ในบรรทัดที่เป็นค่าของตัวแปร r คอลัมน์ ที่ 4 หากตัวแปร r คือ 10 หมายถึง บรรทัดที่ 10 คอลัมน์ที่ 4

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

การใช้ Code จะต้องปรับปรุงเองได้บ้าง หากทำเองไม่ได้เลยกรุณาหาคนที่พอทำได้มาถามกันครับ

[apasri]

ทำตามที่อาจรย์แนะนำ ตอนนี้แก้ไขทั้ง 2 ชีตได้ตามต้องการ และลบชีตที่ไม่ต้องการออกไปด้วยแล้วค่ะ
ขอบคุณอาจารย์ snasui (คนควน) มากค่ะ