: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

รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

ฟอรัมถาม-ตอบปัญหาการใช้งาน 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
akung
Member
Member
Posts: 159
Joined: Sun Mar 11, 2012 10:20 am

รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

#1

Post by akung »

คิดว่าน่าจะเป็น Do loop แต่ไม่รู้จะปรับอย่างไรดีครับ

Code: Select all

Sub SortData()
Dim SortData As String

    Sheets.Add
     ActiveSheet.Name = "SortData"
     
    Sheets("Data").Select
    Range("A10:A17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("B10:B17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A9").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("C10:C17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A17").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("D10:D17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A25").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("E10:E17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A33").Select
    ActiveSheet.Paste
    
     Sheets("Data").Select
    Range("F10:F17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A41").Select
    ActiveSheet.Paste
    
     Sheets("Data").Select
    Range("G10:G17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A49").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("H10:H17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A57").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("I10:I17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A65").Select
    ActiveSheet.Paste
    
    Sheets("Data").Select
    Range("J10:J17").Select
    Selection.Copy
    Sheets("SortData").Select
    Range("A73").Select
    ActiveSheet.Paste
    
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    Sheets("SortData").Select
    Range("A1:A8").Select
    Selection.Copy
    Sheets("Data").Select
    Range("A10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A9:A16").Select
    Selection.Copy
    Sheets("Data").Select
    Range("B10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A17:A24").Select
    Selection.Copy
    Sheets("Data").Select
    Range("C10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A25:A32").Select
    Selection.Copy
    Sheets("Data").Select
    Range("D10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A33:A40").Select
    Selection.Copy
    Sheets("Data").Select
    Range("E10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A41:A48").Select
    Selection.Copy
    Sheets("Data").Select
    Range("F10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A49:A56").Select
    Selection.Copy
    Sheets("Data").Select
    Range("G10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A57:A64").Select
    Selection.Copy
    Sheets("Data").Select
    Range("H10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A65:A72").Select
    Selection.Copy
    Sheets("Data").Select
    Range("I10").Select
    ActiveSheet.Paste
    
    Sheets("SortData").Select
    Range("A73:A80").Select
    Selection.Copy
    Sheets("Data").Select
    Range("J10").Select
    ActiveSheet.Pastee

End Sub
Top
niwat2811
Bronze
Bronze
Posts: 350
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

#2

Post by niwat2811 »

ลองแนบไฟล์ตัวอย่างมาด้วยครับ
Top
akung
Member
Member
Posts: 159
Joined: Sun Mar 11, 2012 10:20 am

Re: รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

#3

Post by akung »

วิธีการคือ ต้องการเรียงข้อมูลใหม่ ในกรณีที่มีการเปลี่ยนแปลง จากที่ยกตัวอย่างถ้า ลบ Cells ที่เป็นตัวอักษรสีแดง ระบบจะต้อง เรียงกันใหม่ให้ถูกต้องครับ ขอบคุณครับ
You do not have the required permissions to view the files attached to this post.
Top
niwat2811
Bronze
Bronze
Posts: 350
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

#4

Post by niwat2811 »

ลองแบบนี้ว่าได้ตามต้องการไหมครับ

Code: Select all

Sub test()
Dim lr As Long, lc As Long
Dim r As Range
Sheets.Add
ActiveSheet.Name = "SortData"
Sheets("Data").Range("A10:J17").Copy Sheets("SortData").Range("A1")
For i = 2 To 10 Step 1
    Cells(1, i).Resize(8, 1).Copy Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Cells(1, i).Resize(8, 1).ClearContents
Next i
lr = Range("A" & Rows.Count).End(xlUp).Row
For Each r In Range("A1:A" & lr)
    If r.Font.Color = 255 Then
        r.ClearContents
    End If
Next r
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
lr = Range("A" & Rows.Count).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column + 1
For i = 9 To lr Step 8
    lc = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Cells(i, 1).Resize(8, 1).Copy Cells(1, lc)
Next i
Range("A1:J8").Copy Sheets("Data").Range("A10")
Application.DisplayAlerts = False
Sheets("SortData").Delete
Application.DisplayAlerts = True
End Sub
Top
akung
Member
Member
Posts: 159
Joined: Sun Mar 11, 2012 10:20 am

Re: รบกวนขอเทคนิคเขียนคำสั่งให้สั้นหน่อยครับ

#5

Post by akung »

Code: Select all

Cells(1, i).Resize(8, 1).ClearContents
ขอบคุณมากครับ แต่ที่ทดสอบมัน Error ตรงนี้ครับ รบกวนด้วยครับ

ไม่เป็นแล้วครับ ไม่ทราบว่าเหตุใดเหมือนกัน
Top
Post Reply

Return to “Excel”