Page 1 of 1
วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Wed Feb 14, 2018 1:43 pm
by crackman
รบกวนสอบถามเรื่องการวางข้อมูลต่อกันเป็นชุดๆ (ชุดละ 7วัน) ใน Row เดียวกัน โดยห้ามวางข้อมูลทับวันเก่า ทำจาก Macro ครับ
1.กำหนดให้ Excel เลื่อนตำแหน่งว่าง อย่างไรครับ
2.กำหนดให้ วางในช่องตำแหน่งว่าง อย่างไรครับ
ขอบคุณมากครับ.
ข้อมูลได้หาได้จากในเวป แต่เอามาใช้ไม่เป็น
Dim rLastCell As Range
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
MsgBox ("The last used column is: " & rLastCell.Column)
----------------------------------------------------------------
Sub LastRow_Example()
Dim LastRow As Long
Dim rng As Range
' Use all cells on the sheet
Set rng = Sheets("Sheet1").Cells
'Use a range on the sheet
'Set rng = Sheets("Sheet1").Range("A1:D30")
' Find the last row
LastRow = Last(1, rng)
' After the last row with data change the value of the cell in Column A
rng.Parent.Cells(LastRow + 1, 1).Value = "Hi there"
End Sub
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Wed Feb 14, 2018 1:53 pm
by puriwutpokin
ควรแนบไฟล์ตัวอย่างและโค้ด และคำตอบที่ต้องการ พร้อมแนบโค้ดให้เป็นโค้ด ตาม เงื่อนไขของบอร์ดนี้ด้วยครับ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Wed Feb 14, 2018 2:13 pm
by crackman
puriwutpokin wrote: Wed Feb 14, 2018 1:53 pm
ควรแนบไฟล์ตัวอย่างและโค้ด และคำตอบที่ต้องการ พร้อมแนบโค้ดให้เป็นโค้ด ตาม เงื่อนไขของบอร์ดนี้ด้วยครับ
รับทราบครับ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 2:20 pm
by crackman
Code: Select all
Windows("Book1").Activate
Range("B3:H3").Select
Selection.Copy
Windows("Book2").Activate
ActiveCell.Offset(0, -1).Range("A2").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Range("A2").Select
Range("A2").Select
ActiveSheet.Paste
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 2:23 pm
by crackman
ต้องการให้วางข้อมูลในแนวนอนต่อกันครับ ตอนนี้มันติด Activecell ติด 2 บรรทัดนี้ครับ รบกวนด้วยนะครับ ขอบคุณมากๆ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 2:27 pm
by logic
ช่วยแนบไฟล์มาด้วยจะได้ช่วยทดสอบครับ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 2:40 pm
by crackman
ใน Macro 1 ในฺไฟล์ Book1 ใช้งานได้ครับ วางไฟล์ต่อกันได้ แต่ใน Macro 4ฺ Book2 เป็นการก็อปปี่ข้ามไฟล์ ยังทำไม่สำเร็จครับ.ขอบคุณมากครับ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 3:07 pm
by logic
ไฟล์ทั้งสองไม่มีมาโครครับ ต้องเซฟเป็น .xlsm ครับ
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 3:09 pm
by crackman
Save Macro 1 ในBook1 ไม่ติดไปครับ เพิ่มเติมให้ครับ
Code: Select all
Sub Macro1()
'
' Macro1 Macro
'
Range("B2:H2").Select '-> Select -> Select data for copy
Selection.Copy '-> Copy data
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlToRight).Select '-> Move to right of border data
ActiveCell.Offset(0, 1).Range("A1").Select '-> Move to next of the border data
ActiveSheet.Paste '-> Paste data
Application.CutCopyMode = False
End Sub
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 3:16 pm
by crackman
เพิ่มให้แล้วครับ ขอโทษนะครับมือใหม่มากๆกำลังศึกษา
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 3:35 pm
by logic
ลองดูครับ
มาโครใน Book2.xlsm
Code: Select all
Sub Macro2()
'
' Macro2 Macro
'
'
Windows("Book1.xlsm").Activate
Range("B2:H2").Select
Selection.Copy
Windows("Book2.xlsm").Activate
Sheets("Report").Select
Range("B2").End(xlToRight).Select
' Selection.End(xlToRight).Select '-> Move to right of border data
Selection.Offset(0, 1).Select '-> Move to next of the border data
ActiveSheet.Paste '-> Paste data
Application.CutCopyMode = False
End Sub
Re: วางข้อมูลในช่อง Cellsว่าง ต่อไป
Posted: Fri Feb 16, 2018 4:24 pm
by crackman
logic wrote: Fri Feb 16, 2018 3:35 pm
ลองดูครับ
มาโครใน Book2.xlsm
Code: Select all
Sub Macro2()
'
' Macro2 Macro
'
'
Windows("Book1.xlsm").Activate
Range("B2:H2").Select
Selection.Copy
Windows("Book2.xlsm").Activate
Sheets("Report").Select
Range("B2").End(xlToRight).Select
' Selection.End(xlToRight).Select '-> Move to right of border data
Selection.Offset(0, 1).Select '-> Move to next of the border data
ActiveSheet.Paste '-> Paste data
Application.CutCopyMode = False
End Sub
ได้แล้วครับ ขอบคุณมากๆ
