VBA จะัให้ excel ตีเส้นที่เหลืออย่างไร
Posted: Thu Jan 30, 2020 1:27 pm
ผมให้ copy จาก sheet 1 มาใส่ sheet"สรุปแผนจัดซื้อจริง" และเหลือ collumn R -S ตีเส้นไม่ได้ จะเขียน vba อย่างไร ครับ
Code: Select all
Sub Addrealbuy()
Dim r1 As Range, rt As Range, rs As Range, r As Range
With Worksheets("sheet1")
Set r1 = .Range("A7", .Range("A1536").End(xlUp))
End With
For Each r In r1
If r.Offset(0, 18).Value <> 0 And IsNumeric(r.Offset(0, 18).Value) Then
With Worksheets("Sheet1")
Set rs = Union(r.Offset(0, 0), r.Offset(0, 1), r.Offset(0, 2), r.Offset(0, 4), r.Offset(0, 6), _
r.Offset(0, 7), r.Offset(0, 8), r.Offset(0, 14), r.Offset(0, 16), r.Offset(0, 18), _
r.Offset(0, 19), r.Offset(0, 20), r.Offset(0, 43), r.Offset(0, 44), r.Offset(0, 45), r.Offset(0, 46), r.Offset(0, 37))
End With
Set rt = Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
rs.Copy rt
Application.CutCopyMode = False
'---------sum qty*unitcost
If rt.Offset(0, 13).Value <> 0 And IsNumeric(rt.Offset(0, 13).Value) Then
rt.Offset(0, 17) = rt.Offset(0, 12) * rt.Offset(0, 10)
Else
rt.Offset(0, 17) = "N/A"
End If
'---------sum qty_remain
rt.Offset(0, 18) = rt.Offset(0, 9) - rt.Offset(0, 12)
End If
Next r
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("A:Z").Font.Name = "TH SarabunPSK"
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("p:p").Font.Bold = False
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("A:Z").EntireRow.AutoFit
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("A:Z").RowHeight = 17
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("c:c").WrapText = True
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("A:Z").Font.ColorIndex = 0
Worksheets("ÊÃػἹ¨Ñ´«×éͨÃÔ§").Columns("A:Z").Interior.ColorIndex = 0
End Sub