: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

การก๊อปปี้คอลัมน์ และ Range

ฟอรัมถาม-ตอบปัญหาการใช้งานสูตรและฟังก์ชัน Excel
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
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

การก๊อปปี้คอลัมน์ และ Range

#1

Post by Polly »

สวัสดีปีใหม่จีนค่ะ

ขอความช่วยเหลือในการเขียนโค้ด 2 เรื่องค่ะ
1. การก๊อปปี้จากคอลัมน์จากชีท "Itemize" เพื่อไปวางที่ชีท "FINAL ITEMIZE" โค้ดนี้เมื่อใช้งานจำนวนที่มากๆ ทำให้เครื่องทำงานช้าผิดปกติ ไม่ทราบว่ามีโค้ดที่ทำให้ข้อมูลวางได้ไวกว่านี้หรือไม่คะ (ดึงมาเป็นบางคอลัมน์ค่ะ)
2. ต้องการให้แสดงชื่อโรค โดยไม่เป็นการกำหนด Range ที่ 30 อยากให้ดึงตามข้อมูลที่มีอยู่ เช่น ที่ชีท "FINAL ITEMIZE" จบที่ 17 ก็ให้จบที่ 17
และต้องการทำให้เป็น pastespecialvalue ค่ะ

มือใหม่ ขอขอบพระคุณล่วงหน้าค่ะ

Code: Select all

Private Sub CommandButton5_Click()
Dim Ir, erow As Integer
Ir = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To Ir
    erow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Sheet5.Cells(i, 1).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 1)

    Sheet5.Cells(i, 2).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 2)
    
    Sheet5.Cells(i, 3).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 3)
    
    Sheet5.Cells(i, 4).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 4)
    
    Sheet5.Cells(i, 5).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 5)
    
    Sheet5.Cells(i, 8).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 6)
    
    Sheet5.Cells(i, 9).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 7)
    
    Sheet5.Cells(i, 10).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 8)
    
    Sheet5.Cells(i, 11).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 9)
    
    Sheet5.Cells(i, 12).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 10)
    
    Sheet5.Cells(i, 13).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 11)
    
    Sheet5.Cells(i, 46).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 12)
    
    Sheet5.Cells(i, 47).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 13)
    
    Sheet5.Cells(i, 17).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 14)
    
    Sheet5.Cells(i, 18).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 15)
    
    Sheet5.Cells(i, 22).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 16)
        
    Sheet5.Cells(i, 26).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 17)
    
    Sheet5.Cells(i, 27).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 18)
    
    Sheet5.Cells(i, 32).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 19)
        
    Sheet5.Cells(i, 33).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 20)
    
    Sheet5.Cells(i, 39).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 21)
    
    Sheet5.Cells(i, 40).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 22)
    
    Sheet5.Cells(i, 41).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 23)
    
    Sheet5.Cells(i, 42).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 24)
    
    Sheet5.Cells(i, 44).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 25)
    
    Sheet5.Cells(i, 45).Copy
    Sheet5.Paste Destination:=Worksheets("FINAL ITEMIZE").Cells(erow, 26)
Next i
Application.CutCopyMode = False
Sheet7.Columns().AutoFit
Range("A1").Select
End Sub

Code: Select all

Option Explicit

Sub Diagnosis()

Worksheets("FINAL ITEMIZE").Activate
Range("AA7") = "Diagnosis (Thai)"
Range("AA8").Select
ActiveCell.FormulaR1C1 = _
  "=IFERROR(VLOOKUP(LEFT(RC[-6],4),'ICD10'!C[-25]:C[-23],2,0),VLOOKUP(LEFT(RC[-6],3),'ICD10'!C[-25]:C[-23],2,0))"
  Selection.Copy
  
 
  Range(Selection, Selection.End(xlDown)).Select
  Range("AA8:AA30").Select
  'Range("AA" & Rows.Count).End(xlUp).Select
   ActiveSheet.Paste
  
  
  Columns("AA:AA").EntireColumn.AutoFit
  'Range("AA").PasteSpecial Paste:=xlPasteValues


  
  Application.CutCopyMode = False
End Sub
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: การก๊อปปี้คอลัมน์ และ Range

#2

Post by puriwutpokin »

ลองปรับเป็น

Code: Select all

Private Sub CommandButton5_Click()
Dim Ir, erow As Integer
Application.ScreenUpdating = False
Ir = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
For i = 7 To Ir
    erow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Sheet5.Cells(i, 1).Resize(, 5).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 1).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 8).Resize(, 6).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 6).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 46).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 12).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 17).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 14).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 22).Resize(, 1).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 16).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 26).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 17).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 32).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 19).PasteSpecial xlPasteValues
    Sheet5.Cells(i, 39).Resize(, 5).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 21).PasteSpecial xlPasteValues
     Sheet5.Cells(i, 44).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 25).PasteSpecial xlPasteValues
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheet7.Columns().AutoFit
Range("A1").Select
End Sub
:shock: :roll: :D
Top
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

Re: การก๊อปปี้คอลัมน์ และ Range

#3

Post by Polly »

ขอบพระคุณอาจารย์มากค่ะ ได้แก้ไขและจะนำไปใช้ประโยชน์ได้อีกหลายรายงานเลยค่ะ :thup:
สำหรับปัญหาที่ติดข้อ 2 ลองปรับโค้ดแล้วแต่ยังติดค่ะ รบกวนช่วยปรับให้หน่อยค่ะ

ที่โมดูลย์ 1 ต้องการหาข้อมูลโรคจากคอลัมน์ U ค่ะติดตรงเมื่อ Vlookup แล้วรายการที่ไม่มีต้องการให้แสดง "Not Found" และอยากปรับให้เป็น PasteSpecialValue ค่ะ

ขอบคุณค่ะ

Code: Select all

Option Explicit

Sub Diagnosis()
Worksheets("FINAL ITEMIZE").Activate
On Error GoTo Polly:


Dim i As Long
Range("AA7") = "Diagnosis (Thai)"

For i = 1 To Range("U10000").End(xlUp).Row - 7
Range("AA" & i + 7).Value = "=IFERROR(VLOOKUP(LEFT(RC[-6],4),'ICD10'!C[-25]:C[-23],2,0),VLOOKUP(LEFT(RC[-6],3),'ICD10'!C[-25]:C[-23],2,0))"
Next
Exit Sub

Polly:
  Range("AA" & i + 7).Value = "NOT FOUND"
  Resume Next
End Sub
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: การก๊อปปี้คอลัมน์ และ Range

#4

Post by puriwutpokin »

ปรับตรงส่วนนี้ครับ

Code: Select all

'Other code...
Range("AA" & i + 7).Value = "=IFERROR(IFERROR(VLOOKUP(LEFT(RC[-6],4),'ICD10'!C[-25]:C[-23],2,0),VLOOKUP(LEFT(RC[-6],3),'ICD10'!C[-25]:C[-23],2,0)),""NOT FOUND"")"
'Other code...
:shock: :roll: :D
Top
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

Re: การก๊อปปี้คอลัมน์ และ Range

#5

Post by Polly »

อาจารย์คะ ตรงโค้ดแรกที่ก๊อปปี้คอลัมน์มาค่ะ พบว่าวันที่ที่ก๊อปมาเป็นตัวเลข 6 หลักต้องการ Format Date ที่เป็นตามต้นฉบับค่ะ เช่น 01-04-2562
รบกวนด้วยอีกครั้งค่ะ ขอบคุณค่ะ
Top
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

Re: การก๊อปปี้คอลัมน์ และ Range

#6

Post by Polly »

อาจารย์คะ

ทำได้แล้วค่ะ ปรับแก้ตรง PasteSpecial เฉยๆ ขอบคุณมากค่ะ :)
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: การก๊อปปี้คอลัมน์ และ Range

#7

Post by puriwutpokin »

Polly wrote: Tue Feb 05, 2019 11:12 am อาจารย์คะ ตรงโค้ดแรกที่ก๊อปปี้คอลัมน์มาค่ะ พบว่าวันที่ที่ก๊อปมาเป็นตัวเลข 6 หลักต้องการ Format Date ที่เป็นตามต้นฉบับค่ะ เช่น 01-04-2562
รบกวนด้วยอีกครั้งค่ะ ขอบคุณค่ะ
้ข้อ 2 แก้ไขเป็นค่าใช่ไหมครับ
ปรับเป็น

Code: Select all

'Other code...
For i = 1 To Range("U10000").End(xlUp).Row - 7
With Range("AA" & i + 7)
.Value = "=IFERROR(IFERROR(VLOOKUP(LEFT(RC[-6],4),'ICD10'!C[-25]:C[-23],2,0),VLOOKUP(LEFT(RC[-6],3),'ICD10'!C[-25]:C[-23],2,0)),""NOT FOUND"")"
.Value = .Value
End With
Next
'Other code...
ส่วนข้อ 1 ตรงคอลัมน์ไหนครับ แต่จริงๆ ใช่ฟอร์แมทที่เซลหรือคอลัมน์นั้นโดยตรงเลยก็ได้ครับ แต่ถ้าจะให้ลงในโค้ดช่วยแจ้งด้วย โค้ดลำดับไหนคอลัมน์ไหนครับ
:shock: :roll: :D
Top
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

Re: การก๊อปปี้คอลัมน์ และ Range

#8

Post by Polly »

สวัสดีค่ะ

สำหรับที่ก๊อปปี้มาที่เป็นเรื่องวันที่ จะอยู่ที่ชีท "Itemize" คอลัมน์ที่ 32-33 (จะเป็นข้อมูลวันที่) หนูปรับเองตามโค้ดข้างล่าง พอได้ไหมคะ
สำหรับที่ให้อาจารย์ช่วยปรับค่าให้เป็น value หลังจาก vlookup เป็นตามที่ต้องการแล้วค่ะ :thup:

ขอบพระคุณมากค่ะอาจารย์

Code: Select all

Sheet5.Cells(i, 32).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 19).PasteSpecial
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: การก๊อปปี้คอลัมน์ และ Range

#9

Post by puriwutpokin »

ถ้าไม่format เอาทั้งหมดก็ปรับตรงนี้ครับ

Code: Select all

Sheet5.Cells(i, 32).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 19).PasteSpecial(xlPasteAll)
:shock: :roll: :D
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: การก๊อปปี้คอลัมน์ และ Range

#10

Post by puriwutpokin »

Polly wrote: Wed Feb 06, 2019 5:25 pm สวัสดีค่ะ

สำหรับที่ก๊อปปี้มาที่เป็นเรื่องวันที่ จะอยู่ที่ชีท "Itemize" คอลัมน์ที่ 32-33 (จะเป็นข้อมูลวันที่) หนูปรับเองตามโค้ดข้างล่าง พอได้ไหมคะ
สำหรับที่ให้อาจารย์ช่วยปรับค่าให้เป็น value หลังจาก vlookup เป็นตามที่ต้องการแล้วค่ะ :thup:

ขอบพระคุณมากค่ะอาจารย์

Code: Select all

Sheet5.Cells(i, 32).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 19).PasteSpecial
ปรับเป็นโค้ดนี้ดีกว่าครับ เผื่อข้อมูลต้นทางมีค่าสี ที่ไม่ต้องการ หรืออะไร เช่นเส้นบรรทัดจะได้ไม่ต้องเอามาด้วยครับ

Code: Select all

Sheet5.Cells(i, 32).Resize(, 2).Copy
    Worksheets("FINAL ITEMIZE").Cells(erow, 19).PasteSpecial xlPasteValuesAndNumberFormats
:D
:shock: :roll: :D
Top
Polly
Member
Member
Posts: 50
Joined: Mon Oct 29, 2018 4:05 pm

Re: การก๊อปปี้คอลัมน์ และ Range

#11

Post by Polly »

ทำได้สำเร็จเพราะอาจารย์เลยค่ะ ขอบพระคุณมากสำหรับความช่วยเหลือค่ะ
Top
Post Reply

Return to “Excel Formulas & Functions”