:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser
🪷 คำแสดงเจตนา
ขอผลแห่งการให้ความรู้นี้ จงกลับไปยังผู้ที่เป็นเจ้าของเดิม แม้ข้าพเจ้าจะไม่รู้จักท่านก็ตาม ขอให้แสงแห่งปัญญาที่ท่านเคยจุดไว้ ได้กลับไปเติมเต็มชีวิตของท่านอีกครั้ง และขอให้เจตนาของข้าพเจ้าเป็นการคืนความดีอย่างสงบ

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

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#1

Post 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 ครับอ่านตามกระทู้ของเพื่อนๆและของอาจารย์ ติดปัญหาก็ได้อาจารย์และเพื่อนๆช่วยเหลือมาตลอด ขอบคุณทุกท่านที่แบ่งปันความรู้ให้ผมครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31175
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#2

Post by snasui »

:D แนบไฟล์ตัวอย่างพร้อมทั้งอธิบายว่าต้องการจะทำอะไร กี่ขั้นตอน ขั้นตอนอะไรบ้าง จะได้สะดวกในการทำความเข้าใจครับ
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#3

Post 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 ที่ผมเขียนแบบบ้านๆครับ ทำพอใช้งานได้ไปก่อน
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#4

Post by piches »

http://www.zabzaa.com/upload/download.p ... 17Demo.rarไฟมีขนาดใหญ่ขออนุญาติแป๊ะ Link นะครับ
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#5

Post by piches »

https://mega.nz/#!hURFVTSI[url]https:// ... #!hURFVTSI[/url]Link สำรองครับ
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#6

Post by piches »

https://mega.nz/#!hURFVTSI!cE-3XIZqotqc ... xTkwUmnGKA
Top
User avatar
bank9597
Guru
Guru
Posts: 3868
Joined: Wed Aug 17, 2011 11:49 am

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

#7

Post by bank9597 »

ไฟล์ใหญ่เกินไปน่ะครับ เปิดไม่ขึ้นเลย

ผมแนะนำให้ทำไฟล์ตัวอย่างมา หรือ แยกถามทีละขั้นตอนจะดีกว่า
Forum Rules
  1. อย่าใช้ภาษาแชทในการตอบ-ถาม
  2. ตั้งชื่อกระทู้ให้สื่อถึงปัญหาและไม่เจาะจงตัวผู้ตอบ
  3. ให้อธิบายปัญหาและระบุคำตอบที่ต้องการมาในฟอรัม
  4. ควรแนบไฟล์ตัวอย่างมาที่ฟอรั่ม
  5. หากใช้ VBA ให้ลองเขียนมาเองก่อนเสมอ
  6. แจ้งผลการใช้งานทุกครั้งเมื่อได้รับคำตอบ
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#8

Post by piches »

ทำให้เล็กลงได้เต็มที่แค่นี้ครับ
You do not have the required permissions to view the files attached to this post.
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#9

Post by piches »

ขั้นตอนการทำงานครับผม
You do not have the required permissions to view the files attached to this post.
Top
User avatar
bank9597
Guru
Guru
Posts: 3868
Joined: Wed Aug 17, 2011 11:49 am

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

#10

Post by bank9597 »

:D ตอนนี้ติดปัญหาอยู่ตรงไหนครับ ผมโหลดไฟล์มาแล้ว ค่อยๆถามกันไปครับ
Forum Rules
  1. อย่าใช้ภาษาแชทในการตอบ-ถาม
  2. ตั้งชื่อกระทู้ให้สื่อถึงปัญหาและไม่เจาะจงตัวผู้ตอบ
  3. ให้อธิบายปัญหาและระบุคำตอบที่ต้องการมาในฟอรัม
  4. ควรแนบไฟล์ตัวอย่างมาที่ฟอรั่ม
  5. หากใช้ VBA ให้ลองเขียนมาเองก่อนเสมอ
  6. แจ้งผลการใช้งานทุกครั้งเมื่อได้รับคำตอบ
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#11

Post 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ได้หรือเปล่าครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31175
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

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

#12

Post 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
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

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

#13

Post 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 ที่อาจารย์แนะนำใช้ได้ตามที่ผมต้องการครับ ผมประยุกต์ใช้แก้ไขข้อมูล เพิ่มเรคคอร์ด เหมาะกับการแก้ไขจำนวนมากๆ ไปที่ฐานข้อมูล ขอบครับอาจารย์
Top
Chitiphat26
Member
Member
Posts: 2
Joined: Tue May 17, 2016 12:50 pm

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

#14

Post by Chitiphat26 »

ดีครับ
Top
Post Reply

Return to “Excel”