: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 ให้สั้นลง

ฟอรัมถาม-ตอบปัญหาการใช้งาน Macro และ 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 ให้สั้นลง

#1

Post by piches »

Code: Select all

Sub Sandto()
Dim sourceWb As Workbook
    Dim wb As Variant
    Dim source As Range
    Application.ScreenUpdating = False
    Set sourceWb = ThisWorkbook
        If Range("B5") = "" Then Exit Sub
    Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B5:E5")
    Set wb = Workbooks.Open("D:\เส้นทางเอกสาร\เส้นทางเอกสาร.xlsx", False, False)
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
    Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B6:E6")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
    Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B7:E7")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B8:E8")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B9:E9")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B10:E10")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B11:E11")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B12:E12")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B13:E13")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B14:E14")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B15:E15")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B16:E16")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B17:E17")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B18:E18")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B19:E19")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B20:E20")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B21:E21")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B22:E22")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B23:E23")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B24:E24")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B25:E25")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B26:E26")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B27:E27")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B28:E28")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
     Set source = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B29:E29")
    i = wb.Worksheets("เส้นทางเอกสาร").Columns("A:A").Find(source, LookIn:=xlValues).Row
    source.Offset(0, 4).Copy
    wb.Worksheets("เส้นทางเอกสาร").Range("E" & i).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    wb.Close True
    Range("B3:D3,F3:G3,I3,B5:B29").ClearContents
    MsgBox "เพิ่มข้อมูลเสร็จแล้ว"
End Sub
ผมพยายามเขียน Code วน Loop แล้วแต่ไม่สำเร็จ ผมเลยเขียน Code แบบบ้านๆให้พอใช้งานได้ก่อนครับ
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ขอความช่วยเหลือย่อ Code ให้สั้นลง

#2

Post by snasui »

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

Re: ขอความช่วยเหลือย่อ Code ให้สั้นลง

#3

Post by piches »

ไฟล์ออกไปส่งลูกค้า B5:B29 IDตรงกับไฟล์เส้นทางเอกสารใน Column A ให้ Coppy ข้อมูล F5:i29 ไปวางที่ไฟล์เส้นทางเอกสาร E:H วางตาม ID ดีครับผม
Attachments
เส้นทางเอกสาร.xlsx
(11.4 KiB) Downloaded 10 times
ออกไปส่งลูกค้า.xlsm
(35.85 KiB) Downloaded 12 times
Screen Shot 2558-11-11 at 21.15.00.png
Screen Shot 2558-11-11 at 21.15.00.png (54.46 KiB) Viewed 74 times
Top
piches
Member
Member
Posts: 88
Joined: Sat Oct 22, 2011 9:15 am

Re: ขอความช่วยเหลือย่อ Code ให้สั้นลง

#4

Post by piches »

Screen Shot 2558-11-11 at 21.39.50.png
Screen Shot 2558-11-11 at 21.39.50.png (50.19 KiB) Viewed 73 times
Top
User avatar
snasui
Site Admin
Site Admin
Posts: 31253
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 2019
Contact:
Contact snasui

Re: ขอความช่วยเหลือย่อ Code ให้สั้นลง

#5

Post by snasui »

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

Code: Select all

Dim sourceWb As Workbook
Dim wb As Variant, rngSourceAll As Range, rngs As Range
Dim source As Range, rngTargetAll As Range
Dim rowFound As Integer

Application.ScreenUpdating = False
Set sourceWb = ThisWorkbook
If Range("B5") = "" Then Exit Sub

With sorcewb.Sheets("ออกไปส่งลูกค้า")
    Set rngSourceAll = .Range("a5", .Range("a" & .Rows.Count).End(xlUp))
End With
'Set rngSourceAll = sourceWb.Sheets("ออกไปส่งลูกค้า").Range("B5:E5")

Set wb = Workbooks.Open("D:\เส้นทางเอกสาร\เส้นทางเอกสาร.xlsx", False, False)
With wb
    Set rngTargetAll = .Range("b5", .Range("b" & .Rows.Count).End(xlUp))
End With

For Each source In rngSourceAll
    If Application.CountIf(rngTargetAll, source) > 0 Then
        rowFound = applicatoin.Match(source, rngTargetAll, 0)
        rngTargetAll(rowFound).Offset(0, 4).Resize(1, 4).Value _
            = source.Offset(0, 4).Resize(1, 4).Value
    End If
Next source
Top
Post Reply

Return to “Excel Macro & VBA”