: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
🪷 คำแสดงเจตนา
ขอผลแห่งการให้ความรู้นี้ จงกลับไปยังผู้ที่เป็นเจ้าของเดิม แม้ข้าพเจ้าจะไม่รู้จักท่านก็ตาม ขอให้แสงแห่งปัญญาที่ท่านเคยจุดไว้ ได้กลับไปเติมเต็มชีวิตของท่านอีกครั้ง และขอให้เจตนาของข้าพเจ้าเป็นการคืนความดีอย่างสงบ

ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

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 a reply


This question is a means of preventing automated form submissions by spambots.
Smilies
:D :thup: :cp: :flw: :rz: :sg: :tt: :) ;) :( :o :shock: :? 8-) :lol: :x :P :oops: :cry: :evil: :twisted: :roll: :!: :?: :idea: :arrow: :ard: :arl: :aru: :| :mrgreen: :geek: :ugeek:

BBCode is ON
[img] is ON
[url] is ON
Smilies are ON

Topic review
   

Expand view Topic review: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#7

by snasui » Sun Aug 01, 2021 10:04 am

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

Code: Select all

'Other code
Dim lastCell As Range, s As String
s = Worksheets("Test").Range("d2").Value
With Sheets("Form")
   If s = "ชาย" Then
       Set lastCell = .Range("A3:F100000").Offset(1, 0).Find("*", _
           searchorder:=xlByColumns, searchdirection:=xlPrevious)
       If lastCell Is Nothing Then
           Set lastCell = .Range("a4")
           lastcol = 2
       End If
   Else
       Set lastCell = .Range("H3:Q100000").Offset(1, 0).Find("*", _
           searchorder:=xlByColumns, searchdirection:=xlPrevious)
       If lastCell Is Nothing Then
           Set lastCell = .Range("h4")
           lastcol = 9
       End If
   End If
   
'        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
   
   If lastCell.Row = 4 Then
       lastrow = 4
       lastcol = lastCell.Column
       If lastCell.Value <> "" Then
           lastrow = lastrow + 1
           lastcol = lastCell.Column - 1
       End If
   ElseIf lastCell.Row >= 10 Then
       lastrow = 4
       lastcol = lastCell.Column + 1
   Else
       lastrow = lastCell.Row + 1
       lastcol = lastCell.Column - 1
   End If
'Other code
ในโอกาสหน้าจะต้องปรับ Code มาเองตามเงื่อนไขที่เพิ่มขึ้นก่อนและเป็นเช่นนี้ทุกกรณี ติดตรงไหนค่อยถามกันต่อตามกฎการใช้บอร์ดข้อ 5 ด้านบนครับ :roll:

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#6

by imeaumm5 » Sun Aug 01, 2021 12:39 am

ขออนุญาตขอคำแนะนำต่อนะคะ หากต้องการจะกำหนดเงื่อนไขเพิ่มเติม โดยการระบุเพศ แล้วข้อมูลจะวิ่งไปตามคอลัมน์ที่แบ่งไว้ แบบนี้สามารถทำได้ไหมคะ

รบกวนแนะนำให้หน่อยค่ะ
ขอบคุณล่วงหน้านะคะ
Attachments
ทดสอบ(เพิ่มเพศ).xlsm
(28.66 KiB) Downloaded 4 times

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#5

by snasui » Sun Jul 25, 2021 6:17 am

imeaumm5 wrote: Sat Jul 24, 2021 6:33 pm ลองเปลี่ยนโค้ดตามที่แนะนำมาใช้ได้แล้วนะคะ ขอบคุณมากเลยค่ะ แต่รบกวนอธิบาย โค้ดนี้ให้หน่อยได้ไหมคะ ว่าเป็นคำสั่งให้ทำอะไรหรอคะ

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ

Code: Select all

 Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)
:D เป็นการหาเซลล์สุดท้ายโดยไม่นับหัวคอลัมน์ครับ

การหาเซลล์สุดท้ายจะเริ่มหาไปทีละคอลัมน์เริ่มจากคอลัมน์ A เป็นต้นไปครับ

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#4

by Bo_ry » Sat Jul 24, 2021 7:10 pm

Code: Select all

Sub Macro1()
Dim a, n&, r&, c&
      a = [B2:C2].Value2
     With Sheets("Form")
        n = Application.CountA(.[A2:Z10]) / 2
        r = n Mod 9 + 2
        c = Int(n / 9) * 2 + 1
        .Cells(r, c).Resize(, 2) = a
    End With
        [B2:C2].ClearContents
        [B2].Select
End Sub

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#3

by imeaumm5 » Sat Jul 24, 2021 6:33 pm

ลองเปลี่ยนโค้ดตามที่แนะนำมาใช้ได้แล้วนะคะ ขอบคุณมากเลยค่ะ แต่รบกวนอธิบาย โค้ดนี้ให้หน่อยได้ไหมคะ ว่าเป็นคำสั่งให้ทำอะไรหรอคะ

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ

Code: Select all

 Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)

Re: ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#2

by snasui » Wed Jul 21, 2021 8:08 am

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

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
     Dim lastCell As Range
     With Sheets("Form")
       Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)
        
'        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        If lastCell Is Nothing Then
            lastrow = 2
            lastcol = 1
        ElseIf lastCell.Row >= 10 Then
            lastrow = 2
            lastcol = lastCell.Column + 1
        Else
            lastrow = lastCell.Row + 1
            lastcol = lastCell.Column - 1
        End If
        .Cells(lastrow, lastcol).Resize(1, 2).Value = Sheets("TEST").Range("b2:c2").Value
'        .Range("a" & lastrow) = lastrow - 1
        
'        .Range("a" & lastrow, .Range("b" & lastrow)).Value = _
            Sheets("TEST").Range("b2:c2").Value
    End With


    Sheets("TEST").Select
    Range("B2:C2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B2").Select
End Sub

ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

#1

by imeaumm5 » Wed Jul 21, 2021 1:24 am

สวัสดีค่ะ ต้องการสอบถามว่าจะทำอย่างไรให้ ข้อมูลในชีท "Form" ทำการขึ้นคอลัมน์ใหม่อัตโนมัติคะ
ตอนนี้ที่ทำได้คือ ต้องทำการคีย์เอง แล้วพอถึงแถวที่10 ข้อมูลก็จะไปเริ่มใหม่ที่ column C และ column D ค่ะ

ตอนนี้ได้ทำMacro การคีย์ข้อมูลในชีท "Test" แล้วให้มันมาอยู่ในชีท "Form" แต่อยากให้ข้อมูลถึงแค่แถวที่10 จากนั้นให้ข้อมูลรันใหม่ใน column C และ Column D แบบนี้ไปเรื่อยๆ ค่ะ รบกวนขอคำแนะนำด้วยนะคะ

Macroค่ะ

Code: Select all

 Sub Macro1()
'
' Macro1 Macro
'

'

     With Sheets("Form")
       
        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("a" & lastrow) = lastrow - 1
        
        .Range("a" & lastrow, .Range("b" & lastrow)).Value = _
            Sheets("TEST").Range("b2:c2").Value
        
    End With


    Sheets("TEST").Select
    Range("B2:C2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B2").Select
End Sub 
และอันนี้เป็นคำสั่งที่ ให้เริ่มColumn ใหม่ (แต่ต้องคีย์เองที่ชีทนั้น)

Code: Select all

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row >= 10 Then
    Cells(Target.Row - 8, Target.Column + 2).Select
    End If
End Sub
...ขอออกตัวก่อนว่าไม่เคยเรียนเรื่องการเขียนโค้ดมาก่อนค่ะ อันนี้เป็นการหาข้อมูลและนำมาประยุกต์เอาค่ะ หากผิดพลาดตรงไหนรบกวนขอคำแนะนำด้วยนะคะ

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ
Attachments
ทดสอบ.xlsm
(31.2 KiB) Downloaded 8 times

Top