VBA จะัให้ excel ตีเส้นที่เหลืออย่างไร

[bkkrong]

ผมให้ 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

[parakorn]

ลองนำโค้ดนี้ไปต่อโค้ดเดิมครับ

Code: Select all

   Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlDiagonalDown).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlDiagonalUp).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlEdgeLeft).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlEdgeTop).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlEdgeBottom).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlEdgeRight).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlInsideVertical).LineStyle = xlNone
    Worksheets("สรุปแผนจัดซื้อจริง").Columns("A:S").Borders(xlInsideHorizontal).LineStyle = xlNone

    Sheets("สรุปแผนจัดซื้อจริง").Select
    Application.Goto Reference:="OFFSET(R6C1,,,COUNTA(C1)-2,19)"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

[Totem]

ตัวอย่าง code ครับ

Code: Select all

'Other code
           '---------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)
                           rt.Offset(0, 17).Borders(xlEdgeLeft).LineStyle = xlContinuous
                           rt.Offset(0, 17).Borders(xlEdgeTop).LineStyle = xlContinuous
                           rt.Offset(0, 17).Borders(xlEdgeRight).LineStyle = xlContinuous
                           rt.Offset(0, 17).Borders(xlEdgeBottom).LineStyle = xlContinuous
                     Else
                     
                    rt.Offset(0, 17) = "N/A"
                    rt.Offset(0, 17).Borders(xlEdgeLeft).LineStyle = xlContinuous
                    rt.Offset(0, 17).Borders(xlEdgeTop).LineStyle = xlContinuous
                    rt.Offset(0, 17).Borders(xlEdgeRight).LineStyle = xlContinuous
                    rt.Offset(0, 17).Borders(xlEdgeBottom).LineStyle = xlContinuous

            End If
            
          '---------sum qty_remain
             rt.Offset(0, 18) = rt.Offset(0, 9) - rt.Offset(0, 12)
             rt.Offset(0, 18).Borders(xlEdgeLeft).LineStyle = xlContinuous
             rt.Offset(0, 18).Borders(xlEdgeTop).LineStyle = xlContinuous
             rt.Offset(0, 18).Borders(xlEdgeRight).LineStyle = xlContinuous
             rt.Offset(0, 18).Borders(xlEdgeBottom).LineStyle = xlContinuous
'Other code