อยากให้ข้อมูลวิ่งตามชื่อมาใส่ในแต่ละ sheet และเปลี่ยนชื่อsheet ตาม cell B2

[March201711]

ที่ sheet Data_BCE เป็นข้อมูล Main ได้ทุกวันจะมีการเปลียนตามมากน้อยของข้อมูล ซึ่งถ้าข้อมูลได้มาแล้วจะต้องกระจายไปแต่ละ sheet โดยดูชื่อ code ID ที่ column U ว่ามีกี่รายการ แล้วไปกระจายแต่ละชีท

Ex : sheet Data_BCE มี 4 รายการ ให้กระจายรายการไป

ที่ sheet1 โดยดู column U ที่ U4 , ตรง sheet1 cell A2 จะมีชื่อว่า 011321-9 และ cell B2 ชื่อ Ms.Kaesorn Vajarapongse และชื่อsheet เปลี่ยนเป็น Mr.Kaesorn ตาม

ที่ sheet2 โดยดู column U ที่ U5 , ตรง sheet1 cell A2 จะมีชื่อว่า 345018-9 และ cell B2 ชื่อ Mr.Pathana Sae-Ow-Eiang และชื่อsheet เปลี่ยนเป็น Mr.Pathana ตาม

ที่ sheet3 โดยดู column U ที่ U6 , ตรง sheet1 cell A2 จะมีชื่อว่า 133823-9 และ cell B2 ชื่อ Mr.Chainapol Akarasupaset และชื่อsheet เปลี่ยนเป็น Mr.Chainapol ตาม

ที่ sheet4 โดยดู column U ที่ U7 , ตรง sheet1 cell A2 จะมีชื่อว่า 470486-9 และ cell B2 ชื่อ Mr.Lutz Wierschin และชื่อsheet เปลี่ยนเป็น Mr.Lutz ตาม

[DhitiBank]

การทำแบบนั้นต้องใช้ VBA ครับ ตามกฎคือจะต้องเขียนมาเองก่อน ติดปัญหาค่อยถามกันต่อครับ

[March201711]

ลองทำแล้วคะ ยังไม่ได้น่ะค่ะ ตามเอกสารแนบ

[snasui]

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

Code: Select all

Sub UpdateData()
    Dim rAll As Range
    Dim r As Range
    Dim sh As Worksheet
    Dim i As Integer
    i = 2
    With Sheets("Data_BCE")
        Set rAll = .Range("u4", .Range("u" & .Rows.Count).End(xlUp))
        For Each r In rAll
            If r.Value = "" Then Exit Sub
            Set sh = Worksheets(i)
            With sh
                .Range("a2:b2").Value = r.Resize(1, 2).Value
                .Name = r.Offset(0, 1).Value
                .Range("b4").Resize(1, 9).Value = _
                    r.Parent.Cells(4, "b").Resize(1, 12).Value
            End With
            i = i + 1
        Next r
    End With
End Sub

[March201711]

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

[snasui]

ลองเปลี่ยนค่า i เป็นค่าอื่นใดที่ไม่ใช่ 2 แล้วสังเกตผลที่ได้ ปรับค่านี้จนไม่ทับชีตที่จะใช้งานครับ

การถามตอบเรื่อง Code เมื่อได้รับคำตอบแล้วจะต้องปรับปรุง Code นั้นมาเองก่อน ติดตรงไหนค่อยถามกันต่อ กรณีถามต่อเนื่องโดยไม่มีการปรับปรุงใด ๆ มาก่อนจะไม่ได้รับคำตอบครับ

[March201711]

ค่ะ สงสัยนิดค่ะ ถ้ามี sheet ที่ hide ไว้อยู่ i ยังนับจำนวนที่ hide ไปด้วยน่ะค่ะ ถ้าจะกำหนดsheet46, 48,49,50 เลยได้ไหมคะ เพราะมีงานอื่น hide ไว้เยอะแยะเลยค่ะ

[snasui]

กำหนดเช่นนั้นได้เลยแต่จะต้อง Loop เป็น กำหนดตรง ๆ จะไม่ยืดหยุ่นครับ

้ถ้าให้ง่าย ชีตที่ต้องการให้แสดงผลให้วางไว้หลังสุดและเรียงต่อเนื่องกันครับ

[March201711]

กำหนด loop ยังไงค่ะ ไม่สันทัดเลยค่ะ

[snasui]

ผมได้โพสต์ทางเลือกแบบไม่ต้อง Loop ไว้แล้วกรุณาทดลองใช้ตามนั้น

งานลักษณะนี้ต้องอาศัย VBA หากไม่ถนัดการ Code ก็ควรทำด้วยด้วยมือแทนการใช้ Code ครับ

[March201711]

ค่ะ จะลองทำดูค่ะ

[March201711]

ถ้า แต่ละ sheetมีข้อมูลเดิมเก่าอยู่แล้ว ข้อมูลใหม่จะไปทับข้อมูลเดิม ต้องปรับ code อย่่างไรคะ

[snasui]

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

[March201711]

พอกด Run แล้ว ข้อมูลที่ sheet Foreign_A column อื่นๆ หายไปหมดเลยค่ะ ซึ่งข้อมูลที่ถูกต้องควรจะเป็น เหมือน Sheet "ข้อมูลที่ถูกต้อง" สีแดง Row ที่ 54,74,108,142,159,176,192 ค่ะ

ซึ่งบางวันมีหลายรายการ บางวันมี 2-3 รายการ ถ้ามีแค่รายการเดียวจะทำให้มีปัญหาค่ะ

Code: Select all

Sub KeepData_Fore()


    Range("B4:E4").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Sheets("Foreign_A").Select

    Range("A3").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("E3").Select

    Sheets("Data_BCE").Select

    Range("G4:I4").Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("Foreign_A").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("F1").Select

    Sheets("Data_BCE").Select

    Range("J1").Select

    Application.CutCopyMode = False

End Sub

[snasui]

ลอง Debug แล้วหรือไม่ครับ ถ้ายังไม่ Debug กรุณาทำการ Debug มาก่อนแล้วแจ้งมาว่าผิดพลาดที่บรรทัดไหนที่ทำให้ข้อมูลหายไปครับ

[March201711]

มันrunได้ค่ะ แต่ไปทับข้อมูลอื่นที่บรรทัดอื่นค่ะ

[snasui]

ทราบครับ เจอบรรทัดนั้นหรือไม่ หาให้เจอก่อนครับ

[March201711]

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

Code: Select all

 
    Range("B4:E4").Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    Sheets("Foreign_A").Select

    Range("A3").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False 

[snasui]

ขอเปลี่ยนคำถาม

ทราบหรือไม่ว่าการ Debug ทำอย่างไร อธิบายมาให้ทราบด้วยครับ

[March201711]

การ Dedug ก็แก้code ค่ะ จะมี high light สีเหลืองแสดงให้เห็นแล้วให้เข้าไปแก้ที่ code นั้นๆเพื่อ ระบบจะได้ทำงานต่อค่ะ