ต้องการสลับพื้นที่เซลล์และข้อความในเซลล์ค่ะ

[tantanz]

ต้องการสลับพื้นที่ที่แสดงเลข 6 และ เลข 7 ค่ะ แต่จาก code ที่ได้ลองทำมันยังสลับไม่ได้
รบกวนช่วยดูให้หน่อยนะคะ

ปล.เวลาสลับกดที่ปุ่มวงกลมด้านขวาค่ะ เวลาเลือกพื้นที่ ลากเม้าส์คลุมช่องเซลที่ต้องการแล้วสลับ(คลุมทุกช่องที่เป็นเลข 6 หรือเลข 7)

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub SwitchColor()
    Dim Temp1 As Variant
    Dim Temp2 As Variant
    Dim Range1 As Range
    Dim Range2 As Range
    On Error Resume Next
    Set Range1 = Application.InputBox(Prompt:="เลือกเครื่องจักรที่ต้องการสลับเครื่องที่1", _
    Title:="Please select range", Default:=Selection.Address, Type:=8)
    Set Range2 = Application.InputBox(Prompt:="เลือกเครื่องจักรที่ต้องการสลับเครื่องที่2", _
    Title:="Please select range", Default:=Selection.Address, Type:=8)
    
    Temp1 = Range1.Interior.Color
    Range1.Interior.Color = Range2.Interior.Color
    Range2.Interior.Color = Temp1
    
    Temp2 = Range1.Range("A1").Value
    Range1 = Range2.Range("A1").Value
    Range2 = Temp2
    
    MsgBox "ทำการสลับเรียบร้อยแล้ว"
    MsgBox Worksheets("sheet1").Range("G57").Value
End Sub

[tantanz]

ลองปรับแล้วค่ะสลับได้ แต่ช่องเซลยังเหมือนเดิม คือต้องการให้ 6 มาสลับกับ 7 แต่ยังคงพื้นที่เดิมของ 6 ไว้ เมื่อย้ายแล้ว พื้นที่ของ 6 จะเป็น G13:H15 แทน
ดังรูปค่ะ

[snasui]

ให้ยกเลิกการ Merge เซลล์ ออกไปก่อน หากไม่ยกเลิกตอนขึ้น InputBox เมื่อคลิกเลือกจะกำหนดค่าให้เซลล์เดียว เนื่องจากถูกมองว่าเป็นเซลล์เดียวกัน เราสามารถคีย์ให้ครอบคลุมขอบเขตของเซลล์ตามที่ควรจะเป็น ใน InputBox ก็ย่อมได้ แต่น่าจะเสียเวลามากกว่า จากนั้นปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Sub SwitchColor()
    Dim Temp1 As Variant
    Dim Temp2 As Variant
    Dim Range1 As Range
    Dim Range2 As Range

    Dim r1addr As String, r2addr As String
    On Error Resume Next
    Set Range1 = Application.InputBox(Prompt:="เลือกเครื่องจักรที่ต้องการสลับเครื่องที่1", _
    Title:="Please select range", Default:=Selection.Address, Type:=8)
    Set Range2 = Application.InputBox(Prompt:="เลือกเครื่องจักรที่ต้องการสลับเครื่องที่2", _
    Title:="Please select range", Default:=Selection.Address, Type:=8)
    r1addr = Range1.Address
    r2addr = Range2.Address
    
    Range1.Cut Range("N1")
    Range2.Cut Range(r1addr)
    Range1.Cut Range(r2addr)
    
    Temp1 = Range1.Interior.Color
    Range1.Interior.Color = Range2.Interior.Color
    Range2.Interior.Color = Temp1
    
    MsgBox "ทำการสลับเรียบร้อยแล้ว"
    MsgBox Worksheets("sheet1").Range("G57").Value
End Sub

[tantanz]

ไม่ได้ค่ะอาจารย์ ลองปรับ code แล้ว จะออกมาตามรูปแบบนี้เลย

หรือมันคือข้อจำกัดของ excel ในการสลับช่องเซลล์คะ

[snasui]

ผมทดสอบแล้วไม่มีปัญหาใดตามภาพด้านล่างครับ

[bank9597]

เจอกระทู้แบบนี้ และคำตอบของอาจารย์ ตาถลุนหลุดจากเบ้ากันไปข้างนึงแน่ครับ อย่างน้อยๆก็ผมคนนึงครับ

[tantanz]

ขอบคุณค่ะ