ช่วยเหลือเรื่อง VBA ในส่วนของการแสดงข้อความจากหลายคอลัมน์เป็นเซลล์เดียวกันหน่อยค่ะ

[yui123]

Code: Select all

Dim input1 As Range, iRow As Long
Dim tempRow As Long, cell As Range
  Dim nRange As Range, aCell As Range, bCell As Range
Set input1 = Worksheets(1).Range("b1") 'ªèͧ·Õè¨Ð¡ÃÍ¡¤ÓãËé¤é¹ËÒ
Worksheets(1).Range("a3").Resize(1000, 10).ClearContents 


For Each cell In Worksheets(4).UsedRange.Offset(1, 0)
If cell.Value = input1.Value Then 
Worksheets(4).Cells(cell.Row, 1).Resize(1, 7).Copy
With Worksheets(1)
Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
End With
End If
Next cell

# ต้องการให้นำข้อมูลที่ค้นหาเจอมาไว้ในเซลเดียวกัน. (เพราะข้อมูลในฐานข้อมูลอยู่คนละคอลัมน์)

[snasui]

ช่วยเขียนหัวกระทู้ให้เป็นไปตามกฎการใช้บอร์ดข้อ 2 ด้านบนด้วยครับ

[yui123]

Code: Select all

Dim input1 As Range, iRow As Long
Dim tempRow As Long, cell As Range
  Dim nRange As Range, aCell As Range, bCell As Range
Set input1 = Worksheets(1).Range("b1") 'ªèͧ·Õè¨Ð¡ÃÍ¡¤ÓãËé¤é¹ËÒ
Worksheets(1).Range("a3").Resize(1000, 10).ClearContents 


For Each cell In Worksheets(4).UsedRange.Offset(1, 0)
If cell.Value = input1.Value Then 
Worksheets(4).Cells(cell.Row, 1).Resize(1, 7).Copy
With Worksheets(1)
Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
End With
End If
Next cell

# ต้องการให้นำข้อมูลที่ค้นหาเจอมาไว้ในเซลเดียวกัน. (เพราะข้อมูลในฐานข้อมูลอยู่คนละคอลัมน์)

[snasui]

Code นี้เป็น Code ที่ผมเขียนตอบท่านอื่น

ให้แนบไฟล์ตัวอย่างของตนเองมาพร้อมทั้งปรับ Code ด้วยตนเองให้เป็นไปตามที่ต้องการ ติดแล้วค่อยถามกันต่อครับ

[yui123]

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

โค้ดการบันทึกข้อมูลจะอยู่ในชีทที่ 2 ในปุ่ม บันทึก
(แนบไฟล์ไม่ได้ค่ะ เป็นไฟล์ขนาดใหญ่)


โค้ดในปุ่มบันทึก

Code: Select all

Sub savedata1()
Dim check1 As Long
Dim i As Integer
Dim z1 As Long

check1 = Worksheets(2).Range("a4").End(xlDown).Row


For i = endrow1 To check1
Worksheets(6).Cells(z1 + 1, 1).Value = Worksheets(2).Cells(i, 1).Value
Worksheets(6).Cells(z1 + 1, 2).Value = Worksheets(2).Cells(i, 2).Value
Worksheets(6).Cells(z1 + 1, 3).Value = Worksheets(2).Cells(i, 3).Value
Worksheets(6).Cells(z1 + 1, 4).Value = Worksheets(2).Cells(i, 4).Value
Worksheets(6).Cells(z1 + 1, 5).Value = Worksheets(2).Cells(i, 5).Value
Next i
End Sub

[yui123]

โค้ดในปุ่มค้นหา ชีทที่ 2 (เพื่ออาจารย์ต้องการจะดูควบคู่ไปด้วยค่ะ)

Code: Select all

Sub Button1_คลิก()
Dim z1 As Long
Dim endrow1 As Long
Dim input1 As Range, irow As Long
Dim tempRow As Long, cell As Range
  Dim nRange As Range, aCell As Range, bCell As Range
Set input1 = Worksheets(2).Range("b1") 
Worksheets(2).Range("a5").Resize(1000, 10).ClearContents 



For Each cell In Worksheets(5).UsedRange.Offset(1, 0)
If cell.Value = input1.Value Then
Worksheets(5).Cells(cell.Row, 1).Resize(1, 5).Copy
With Worksheets(2)
Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
End If
Next cell

Worksheets(2).Range("a1").End(xlDown).Offset(1, 0).Select
endrow1 = Selection.Row
endrow1 = endrow1 + 1
z1 = Worksheets(6).End(xlDown).Select.Row
End Sub

[snasui]

ตัวอย่างการบันทึกข้อมูลลงฐานข้อมูลดูที่นี่ครับ viewtopic.php?f=9&t=7248

สำหรับไฟล์แนบให้ทำมาเป็นไฟล์ตัวอย่างซึ่งไม่ควรมีขนาดใหญ่ครับ

[yui123]

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

[snasui]

ตัวอย่าง Code ตามด้านล่าง เป็นการเขียน Code ให้จัดการกับ Table เนื่องจากมีการนำ Table มาใช้

Code: Select all

Sub save1()
    Dim lastRow As Long, sourceRange As Range
    With Sheets("Sheet3")
        lastRow = .ListObjects("Table1").ListRows.Count
        Set sourceRange = .ListObjects("Table1").ListRows(lastRow).Range
    End With
    With Sheets("Sheet4")
        .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 5).Value = _
            sourceRange.Value
    End With
End Sub

[yui123]

อาจารย์ค่ะ เมื่อกด save แล้วไม่มีอะไรเปลี่ยนแปลงเลยค้ะยังเหมือนเดิม.


ทำงานกับชีทอันที่ 2 ชื่อ sheet3 เมื่อใส่ไอดีละกดค้นหาข้อมูลจะแสดง และเมื่อเรากรอกข้อมูลเพิ่ม แล้วกดบันทึกข้อมูลจะไปอยู่ในแถวสุดท้ายของชีทชื่อว่า profile
โค้ดการบันทึกอยู่ในปุ่ม save ในชีทอันที่ 2 ค้ะ

[snasui]

Code นั้นทำงานถูกต้องแล้ว โดยจะ Copy เอาบรรทัดสุดท้ายของ Table ไปไว้ในชีท Profile โดย Table นั้นจะต้องไม่มีบรรทัดว่าง ดูภาพประกอบด้านล่าง

แต่ที่เป็นปัญหาคือ เมื่อกดแป้นค้นหาแล้ว Table มีการแทรกบรรทัดว่างขึ้นมา ควรแก้ไขตรงนี้เสียก่อนครับ

ที่บอกว่ากรอกข้อมูลเพิ่ม กรอกที่บรรทัดใดของ Table ครับ

[yui123]

อาจารย์ค่ะ แล้วถ้ากรณีที่ไม่ใช่ตาราง ต้องปรับแก้ตรงไหนหรอค้ะ

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub tttt()
  Dim sourceRange As Range
    With Sheets("Sheet3")
        Set sourceRange = .Range("a" & .Rows.Count).End(xlUp).Resize(1, 5)
    End With
    With Sheets("profile")
        .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 5).Value = _
            sourceRange.Value
    End With
End Sub

[yui123]

ถ้ากรณีที่ผู้ใช้เพิ่มรายชื่อไปมากกว่าหนึ่งชื่อ ต้องแก้ไขตรงไหนหรอค้ะ

[snasui]

แก้มาเองครับ ติดตรงไหนค่อยถามกันต่อ

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

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

[yui123]

ขอบคุณค่ะ จะลองพยายามปรับแก้ดูนะค้ะอาจารย์

[yui123]

Code: Select all

Sub savedata1()
Dim check1 As Long
Dim i As Integer
Dim z1 As Long

check1 = Worksheets(2).Range("a4").End(xlDown).Row
z1 = Worksheets(6).End(xlDown).Select.Row

End Sub

ใช้ในการจัดเก็บข้อมูล พอนำมาใส่โค้ดจะ Debug ตรง z1 ค้ะ

[snasui]

ก่อนจะ End(xlUp) หรือ End(xlDonw) หรืออื่น ๆ จะต้องเป็น Range ไม่ใช่อ้างแค่ชีท สังเกตตัวอย่างในโพสต์ก่อน ๆ ครับ

[yui123]

อาจารย์ช่วยแนะนำหน่อยได้ไหมค่ะ

[snasui]

อ่านที่ผมตอบแล้วทำตามนั้น ไม่เข้าใจข้อความใดที่ผมตอบ ให้นำข้อความนั้นมาถามครับ