Excel Forum

ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
http://snasui.com/

Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

http://snasui.com/viewtopic.php?t=10017

Page 1 of 1

Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Thu May 12, 2016 4:39 pm
by piches

Code: Select all

Sub test()
Dim wb As Variant
Dim source As Range
If Worksheets("PalDying").Range("B6").Value = "" Then End
i = Worksheets("Dyreport").Range("A6:A23").Find(Range("D6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("A4:R4").Copy
Worksheets("Dyreport").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B6").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B6:U6").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
i = Worksheets("Report").Range("A:A").Find(Range("B6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B6:U6").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B7").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B7"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B7:U7").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B7").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B7"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B7:U7").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B8").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B8"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B8:U8").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B8").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B8"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B8:U8").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B9").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B9"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B9:U9").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B9").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B9"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B9:U9").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B10").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B10"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B10:U10").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B10").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B10"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B10:U10").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B11").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B11"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B11:U11").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B11").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B11"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B11:U11").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B12").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B12"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B12:U12").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B12").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B12"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B12:U12").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B13").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B13"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B13:U13").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B13").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B13"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B13:U13").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B14").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B14"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B14:U14").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B14").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B14"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B14:U14").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B15").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B15"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B15:U15").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B15").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B15"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B15:U15").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B16").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B16"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B16:U16").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B16").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B16"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B16:U16").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B17").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B17"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B17:U17").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B17").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B17"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B17:U17").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B18").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B18"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B18:U18").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B18").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B18"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B18:U18").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B19").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B19"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B19:U19").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B19").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B19"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B19:U19").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B20").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B20"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B20:U20").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B20").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B20"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B20:U20").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True
    Application.ScreenUpdating = True
     Worksheets("PalDying").Range("B3:L3,A6:U26").ClearContents
    Range("B3").Activate
End Sub
ผมเข้าใจภาษา vb ครับอ่านตามกระทู้ของเพื่อนๆและของอาจารย์ ติดปัญหาก็ได้อาจารย์และเพื่อนๆช่วยเหลือมาตลอด ขอบคุณทุกท่านที่แบ่งปันความรู้ให้ผมครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Thu May 12, 2016 8:56 pm
by snasui
:D แนบไฟล์ตัวอย่างพร้อมทั้งอธิบายว่าต้องการจะทำอะไร กี่ขั้นตอน ขั้นตอนอะไรบ้าง จะได้สะดวกในการทำความเข้าใจครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Fri May 13, 2016 3:39 pm
by piches
ขั้นตอนการทำงาน
1 sheet Add Q (ใช้เพิ่มคิวผลิต)
ป้อนเลขที่บิลในเซล A3 เพื่อดึงข้อมูลจากไฟล์ Production Control.xlsx และหากมีเลขที่บิลนี้แล้วใน Sheet Report ให้เลขที่บิลนั้นเติมท้ายด้วย /ซ(จาก5901195244 เป็น 5901195244/ซ)
คำนวนเวลาผลิตตามเงื่อนไข จากตรารางคำนวนใน Sheet CT (CTย่อมาจาก Cycle Time = เวลาที่ใช้ในการผลิตหรือประกอบงานหนึ่งรอบกระบวนการ)
สร้าง Group โดยใช้เลขที่บิลแรกเป็น LOT ในการผลิตรวมหลายๆบิล (เพื่อความสดวกและลดเวลาลดการผิดพาด ในการบันทึกข้อมูล)
บันทึกรายการต่อท้ายที่ Sheet Report collumn A2:O (เป็นตัวหนังสือสีดำ)

2 Sheet PalDying (ส่งรายการเข้าผลิต ปันทึกติดตามตรวจสอบเวลาการผลิต)
ป้อนเลขที่ LOT ในเซล B3 เพื่อดึง Group ที่ต้องการผลิตขึ้นมา ค้นหาเลขที่บิลที่ตรงกับ Sheet Report
แล้วบันทึกข้อมูลไปที่เดิม(Sheet Report)แต่เพิ่มข้อมูลใน collumn P:Tข้อมูลที่เพิ่มคือ(เริ่มย้อมเวลา ควรเสร็จ ขบวนการย้อม ชื้อพนักงานเข้าย้อม กะ)
และตัวหนังสือจะเปลี่ยนสถานะเป็น สีเขียว เพื้อให้รู้ว่ากำลังผลิตอยู่
และส่งข้อมูลอีกชุดไปที่ Sheet Dyreport โดยมีเงื่อนไขให้ตรงตามชื้อเครื่อง เพื่อจับเวลาการผลิต

3 Sheet Dyaction (ใช้บันทึกข้อมูลการผลิตตั้งแต่เริมผลิตจนผลิตเสร็จ)
จะคล้ายคลึงกับ Sheet PalDying ป้อนเลขที่ LOT ในเซล E3 เพื่อดึง Group ที่ต้องการขึ้นมา ค้นหาเลขที่บิลที่ตรงกับ Sheet Report
แล้วบันทึกข้อมูลไปที่เดิม(Sheet Report)แต่เพิ่มข้อมูลใน collumn U:AA ข้อมูลที่เพิ่มคือ(ย้อมเสร็จเวลา เวลาย้อมจริง ประสิทธิภาพ ชื้อพนักงานออกย้อม กะ ผลการย้อม หมายเหตุ)
และตัวหนังสือจะเปลี่ยนสถานะเป็น น้ำเงิน เพื้อให้รู้ว่าผลิตเสร็จแล้ว
และลบรายการที่ Sheet Dyreport โดยมีเงื่อนไขให้ตรงตามชื้อเครื่องแล้วลบรายการนั้นออก(เฉพราะช่วง Collumn B:R)

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

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Fri May 13, 2016 3:56 pm
by piches
http://www.zabzaa.com/upload/download.p ... 17Demo.rarไฟมีขนาดใหญ่ขออนุญาติแป๊ะ Link นะครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Fri May 13, 2016 4:06 pm
by piches
https://mega.nz/#!hURFVTSI[url]https:// ... #!hURFVTSI[/url]Link สำรองครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Fri May 13, 2016 4:14 pm
by piches
https://mega.nz/#!hURFVTSI!cE-3XIZqotqc ... xTkwUmnGKA

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 11:44 am
by bank9597
ไฟล์ใหญ่เกินไปน่ะครับ เปิดไม่ขึ้นเลย

ผมแนะนำให้ทำไฟล์ตัวอย่างมา หรือ แยกถามทีละขั้นตอนจะดีกว่า

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 4:06 pm
by piches
ทำให้เล็กลงได้เต็มที่แค่นี้ครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 4:26 pm
by piches
ขั้นตอนการทำงานครับผม

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 5:01 pm
by bank9597
:D ตอนนี้ติดปัญหาอยู่ตรงไหนครับ ผมโหลดไฟล์มาแล้ว ค่อยๆถามกันไปครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 5:09 pm
by piches

Code: Select all

Sub test()
Dim wb As Variant
Dim source As Range
If Worksheets("PalDying").Range("B6").Value = "" Then End
i = Worksheets("Dyreport").Range("A6:A23").Find(Range("D6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("A4:R4").Copy
Worksheets("Dyreport").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B6").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B6:U6").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
i = Worksheets("Report").Range("A:A").Find(Range("B6"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B6:U6").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B7").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B7"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B7:U7").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B7").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B7"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B7:U7").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B8").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B8"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B8:U8").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B8").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B8"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B8:U8").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B9").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B9"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B9:U9").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B9").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B9"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B9:U9").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B10").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B10"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B10:U10").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B10").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B10"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B10:U10").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B11").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B11"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B11:U11").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B11").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B11"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B11:U11").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B12").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B12"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B12:U12").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B12").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B12"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B12:U12").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B13").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B13"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B13:U13").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B13").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B13"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B13:U13").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B14").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B14"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B14:U14").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B14").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B14"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B14:U14").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B15").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B15"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B15:U15").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B15").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B15"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B15:U15").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B16").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B16"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B16:U16").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B16").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B16"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B16:U16").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B17").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B17"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B17:U17").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B17").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B17"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B17:U17").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B18").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B18"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B18:U18").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B18").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B18"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B18:U18").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B19").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B19"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B19:U19").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B19").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B19"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B19:U19").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True

If Worksheets("PalDying").Range("B20").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B20"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B20:U20").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteFormats, Transpose:=False
Application.CutCopyMode = True
If Worksheets("PalDying").Range("B20").Value = "" Then End
i = Worksheets("Report").Range("A:A").Find(Range("B20"), LookIn:=xlValues).Row
Worksheets("PalDying").Range("B20:U20").Copy
Worksheets("Report").Range("A" & i).PasteSpecial xlPasteValues, Transpose:=False
Application.CutCopyMode = True
    Application.ScreenUpdating = True
     Worksheets("PalDying").Range("B3:L3,A6:U26").ClearContents
    Range("B3").Activate
End Sub
ผมอยากทราว่า Codeนี้สามารถเขียนแบบวนLoopได้หรือเปล่าครับ

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Sat May 14, 2016 11:05 pm
by snasui
:D ตัวอย่างการ Loop ตามด้านล่าง ลองปรับใช้ดูครับ

Code: Select all

Dim rall As Range, r As Range
With Worksheets("PalDying")
    if .Range("b6").Value = "" Then End
    Set rall = .Range("b6", .Range("b" & .Rows.Count).End(xlUp))
End With
For Each r In rall
    i = Worksheets("Report").Range("A:A").Find(r, LookIn:=xlValues).Row
    r.Resize(1, 20).Copy
    Worksheets("Report").Range("a" & i).Resize(1, 20).PasteSpecial xlPasteFormats
    Worksheets("Report").Range("a" & i).Resize(1, 20).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next r

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Tue May 17, 2016 11:37 am
by piches
:thup:

Code: Select all

Sub senddata()
Dim rall As Range, r As Range
With Worksheets("form")
    If .Range("b6").Value = "" Then End
    Set rall = .Range("b6", .Range("b" & .Rows.Count).End(xlUp))
End With
Set wb = Workbooks.Open("C:\Users\IT\Desktop\บิลเงินสด\เส้นทางเอกสาร.xlsx", False, False)
For Each r In rall
    i = Worksheets("เส้นทางเอกสาร").Range("a:a").Find(r, LookIn:=xlValues).Row
    r.Resize(1, 14).Copy
    Worksheets("เส้นทางเอกสาร").Range("a" & i).Resize.Offset(0, 0).PasteSpecial xlPasteFormats
    Worksheets("เส้นทางเอกสาร").Range("a" & i).Resize.Offset(0, 0).PasteSpecial xlPasteValues
       Application.CutCopyMode = False
Next r
wb.Close True
Worksheets("form").Range("A6:N100").ClearContents
    Range("B4").Activate
End Sub
Code ที่อาจารย์แนะนำใช้ได้ตามที่ผมต้องการครับ ผมประยุกต์ใช้แก้ไขข้อมูล เพิ่มเรคคอร์ด เหมาะกับการแก้ไขจำนวนมากๆ ไปที่ฐานข้อมูล ขอบครับอาจารย์

Re: Code นี้ สามารถย่อ หรือเขียนวน Loop ได้หรือเปล่าครับ

Posted: Tue May 17, 2016 12:51 pm
by Chitiphat26
ดีครับ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited