เริ่มเขียน VBA ใน Excel

[Teerawut]

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

ขอบพระคุณมากครับ

[snasui]

กรณีเป็น VBA จำเป็นต้องทำตามกฎการใช้บอร์ดข้อ 5 ด้านบน สำหรับมือใหม่ให้หัดทำตามหนังสือก่อน ติดตรงไหนสามารถสอบถามมาได้

ส่วนจะเป็นหนังสือเล่มใดนั้นผมช่วยไม่ได้มากเพราะผมไม่ได้อ่านหนังสือไทย จะอ่านจาก Help ชองโปรแกรมเป็นหลักครับ

[Teerawut]

2013 2013 2013 2013 2013 2013 2013 2013 2013
2014 2013 2013 2013 2013 2013 2013 2013 2013
2014 2013 2013 2013 2013 2013 2013 2013 2013
2015 2013 2013 2013 2013 2013 2013 2013 2013

ใน column แรก ต้องการค้นหา ปี 2014 แล้ว copy ไป ทั้งบรรทัด อีก sheet หนึ่ง
ใช้คำสั่งคือ
On Error Resume Next
xx = DatePart("yyyy", Date)
With Sheets("Sheet1").Range("a:a")
Set c = .Find(What:=xx, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
firstaddr = c.Address
Do
c.Value = ""
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddr
End If
End With
'Sheets("Sheet1").Range("a:a").SpecialCells( _
' xlCellTypeBlanks).EntireRow.Copy
Sheets("Sheet1").Range("a:a").SpecialCells( _
xlCellTypeBlanks).EntireRow.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste

แต่เมื่อไปหน้าผลลัพธ์ ปี 2014 หายไป เหลือดังข้างล่างครับ
2013 2013 2013 2013 2013 2013 2013 2013
2013 2013 2013 2013 2013 2013 2013 2013

แก้ยังไงครับ
ขอบคุณครับ

[snasui]

แนบไฟล์ตัวอย่างมาด้วยและควรโพสต์ Code ให้แสดงเป็น Code โดยดูตัวอย่างได้ที่ Link นี้ครับ viewtopic.php?style=3&f=3&t=1187

[Teerawut]

ครับ ผมแนบไฟล์แล้วครับ

example#1.xlsm

[Teerawut]

Code: Select all

Sub tesr()
'xx = Worksheets("sheet1").Range("c5").Value
'Worksheets("sheet1").Range("c15").Value = xx
'i = WorksheetFunction.CountA(Worksheets("sheet1").Columns("C:C")) + 5
'Worksheets("sheet1").Cells(i, 3).Value = "Add data"
On Error Resume Next
    xx = DatePart("yyyy", Date)
    With Sheets("Sheet1").Range("a:a")
        Set c = .Find(What:=xx, After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            firstaddr = c.Address
            Do
                c.Value = ""
                Set c = Cells.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddr
        End If
    End With
    'Sheets("Sheet1").Range("a:a").SpecialCells( _
    '    xlCellTypeBlanks).EntireRow.Copy
    Sheets("Sheet1").Range("a:a").SpecialCells( _
       xlCellTypeBlanks).EntireRow.Copy
    Sheets("Sheet2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
   
End Sub

[tupthai]

ลองทดสอบดูครับ

Code: Select all

Sub tesr()
   xx = DatePart("yyyy", Date)
   With Range("a:a")
        Set c = .Find(xx, LookIn:=xlValues)
        If Not c Is Nothing Then
              firstAddress = c.Address
              Do
                 i = i + 1
                 c.EntireRow.Copy Sheets("Sheet2").Cells(1 & i)
                 Set c = .FindNext(c)
              Loop While Not c Is Nothing And c.Address <> firstAddress
         End If
    End With
End Sub

[Teerawut]

โปรแกรมแจ้ง error ที่บรรทัด c.EntireRow.Copy Sheets("Sheet2").Cells(1 & i)ครับ
ว่าไม่สามารถ copy ได้ ขนาดของ Cell ที่เลือกไม่เท่ากันครับ

[snasui]

สามารถปรับ Code จาก c.EntireRow.Copy Sheets("Sheet2").Cells(1 & i) เป็น c.EntireRow.Copy Sheets("Sheet2").Cells(i, 1) ครับ

[Teerawut]

ขอบพระคุณมากครับ สามารถ copy ตามเงื่อนไขได้แล้วครับ

[Teerawut]

เรียนถามอาจารย์ตามโค้ชด้านล่าง ในcolumn F และ G ผมต้องใส่สูตร ตามโค้ช

ถ้าจำนวนแถวมากขึ้น ต้องแก้ไขโค้ชอย่างไรครับ

Code: Select all

Sub Macro6()
'
' Macro6 áÁâ¤Ã
'

'
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4],0)"
    Range("G1").Select
    Columns("G:G").ColumnWidth = 12.13
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-4],0)"
    Range("G1").Select
    Selection.AutoFill Destination:=Range("G1:G15"), Type:=xlFillDefault
    Range("G1:G15").Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF((RC[-2]-RC[-3])<0,(RC[-2]-RC[-3])*-1,RC[-2]-RC[-3])"
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H15"), Type:=xlFillDefault
    Range("H1:H15").Select
End Sub

[snasui]

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

Code: Select all

Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G" & Range("G1").CurrentRegion.Rows.Count), Type:=xlFillDefault

[Teerawut]

ขอบคุณครับ