การเขียน VB ให้เลือกข้อมูลจากคอลัมน์ A แล้วให้ขีดเส้นทั้งแถว

[dal252244]

รบกวนผู้รู้หน่อยนะครับ ผมไม่มีความรู้เรื่อง VB จึงอยากรบกวนช่วยแนะนำการเขียนหน่อยครับ โดยคอลัมน์ A มีข้อมูลเลข 1 กับ 2 อยากจะเขียน VB ให้เลือกเฉพาะข้อมูลที่มีเลข 2 แล้วทำการขีดเส้นทึบแถวนั้นทั้งแถวครับ เนื่องจากไม่มีความรู้ทางด้านนี้ รบกวนช่วยแนะนำด้วยนะครับว่าจะเขียนเป็น VB หรือใช้วิธีใดได้บ้าง

[snasui]

การถามตอบ VBA ต้องเป็นไปตามกฎการใช้บอร์ดข้อ 5 ด้านบนครับ

[dal252244]

ขอโทษด้วยครับ ผมลองทำจากการบันทึกMacro แล้วลองแก้เบื้องต้น ทำได้ในระดับหนึ่งครับ แต่เวลาจะเพ่ิม เลข 2 ในแถวถัดลงมา เมื่อกดรันสูตรเส้นขีดล่างไม่ขึ้นครับ ยังคงขึ้นที่เดิม ไม่ทราบว่าผมต้องแก้ตรงไหนครับ รบกวนด้วยนะครับ

Code: Select all

Sub Macro3()
'
' Macro3 Macro
'

'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveSheet.Range("$T:$T").AutoFilter Field:=1, Criteria1:="2"
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A6:S2000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveSheet.Range("$T:$T").AutoFilter Field:=1
End Sub

[dal252244]

ไฟล์แนบครับ

[snasui]

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

Code: Select all

Sub line6()
'
' line6 Macro
'

'
    
    For Each Rng In ActiveSheet.Range("$T$6:$T$60001").SpecialCells(xlCellTypeConstants)
        
        If Rng.Value = 2 Then
        
            Range(Range("A" & Rng.Row), Cells(Rng.Row, "S")).Select
            Selection.Borders(xlDiagonalDown).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 = xlHairline
            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
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Else
            Range(Range("A" & Rng.Row), Cells(Rng.Row, "S")).Select
            Selection.Borders(xlDiagonalDown).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 = xlHairline
'            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlHairline
            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
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        End If
    Next Rng
    Range("B6").Select
    
End Sub

[dal252244]

ทำได้แล้วครับ ขอบคุณมากครับอาจารย์