:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup:

:!: โปรดทราบ :!:
  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 ย้ายข้อมูล

ฟอรัมถาม-ตอบปัญหาการใช้งาน 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. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
predee16
Member
Member
Posts: 86
Joined: Wed Feb 27, 2019 4:13 pm
Excel Ver: 2007

เพิ่มเติม Code ย้ายข้อมูล

#1

Post by predee16 »

ผมต้องการย้ายข้อมูลจาก Sheet Dataไปที่ Sheet Cut of InterCo โดยมีเงื่อนไขดังนี้ครับ
- Column AC ที่มีคำว่า "Cut of InterCo" ให้ย้ายไปที่ Sheet "Cut of InterCo"
- และไม่ใช่ Column W ที่มีคำว่า "TT" กลุ่มนี้เอาไว้ที่ Sheet เดิม
ซึ่ง Code ที่มีอยู่ตอนนี้มันเอาคำว่า "Cut of InterCo" มาทั้งหมดครับ

Code: Select all

Sub test()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Data").UsedRange.Rows.Count
    J = Worksheets("Cut of InterCo").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Cut of InterCo").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Data").Range("aC2:aC" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Cut of InterCo" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Cut of InterCo").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Cut of InterCo" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
 Range("A2:AK20000").Sort Key1:=Range("A2"), _
                     Order1:=xlAscending, _
                     Header:=xlNo
End Sub

Image
You do not have the required permissions to view the files attached to this post.
niwat2811
Bronze
Bronze
Posts: 336
Joined: Thu Jan 06, 2011 12:51 pm
Excel Ver: 2016

Re: เพิ่มเติม Code ย้ายข้อมูล

#2

Post by niwat2811 »

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

Code: Select all

Sub Test1()
Dim lr As Long, Rng As Range
lr = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("A1:AK" & lr).AutoFilter Field:=29, Criteria1:= _
        "Cut of InterCo"
    ActiveSheet.Range("A1:AK" & lr).AutoFilter Field:=23, Criteria1:="<>TT"
    ActiveSheet.Range("A2:AK" & lr).Copy Sheets("Cut of InterCo").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Set Rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
    Rng.EntireRow.Delete
    ActiveSheet.ShowAllData
End Sub
predee16
Member
Member
Posts: 86
Joined: Wed Feb 27, 2019 4:13 pm
Excel Ver: 2007

Re: เพิ่มเติม Code ย้ายข้อมูล

#3

Post by predee16 »

niwat2811 ใช้งานได้ตามต้องการ ขอบคุณมากครับ
Post Reply