อยากได้ Vba ลบค่าว่าง ในเซลล์ครับ

[kubota]

ผมลอง หา สูตร มาแล้ว แต่ไม่ได้ผล ครับ

Code: Select all

Sub RoundedRectangle1_Click()
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("c3", "c9")
        If rng.Value = "" Then
            Selection.Delete Shift:=xlUp
        End If
    Next rng
End Sub

[snasui]

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

Code: Select all

Sub RoundedRectangle1_Click()
    Dim rng As Range
    Dim i As Integer
    For Each rng In Sheets("Sheet1").Range("c3", "c9")
        If rng.Value = "" Then
            rng.ClearContents
            i = i + 1
        End If
    Next rng
    If i > 0 Then
        Sheets("Sheet1").Range("c3", "c9") _
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
End Sub

[kubota]

ขอบคูณมากครับ..แต่สูตรยังไม่ใช้ที่ตอบโจทย์ครับ
คืออยากลบ เฉพาะเซลล์ ที่อ้างอิง จาก คอลัม C ไม่ใช่ลบทั้งแถว

จากไฟล์ที่แนบ คือช่อง C7 กับ C9 ว่าง ที่นี้เวลาเรารัน Vba ให้ลบเฉพาะ เซลล์ที่ว่างกับคอลัมที่มีข้อมูลด้วย

ตัวอย่างนะครับ
เช่น C7 ว่าง ให้Vba ลบเซลล C7+D7 +E7 ครับ ไม่ใช่ลบทั้งแถว
ขอบคุณมากครับ

[astalavista]

ลองปรับเป็น

Code: Select all

Sub RoundedRectangle1_Click()
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("C3:E9").Rows
        If Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(rng)), "") = "" Then
            rng.Delete shift:=xlUp
        End If
    Next
End Sub

[kubota]

ลองปรับเป็น

Code: Select all

Sub RoundedRectangle1_Click()
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("C3:E9").Rows
        If Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(rng)), "") = "" Then
            rng.Delete shift:=xlUp
        End If
    Next
End Sub

ใช้แล้วครับ ต้องการแบบนี้เลย ขอบคุณมากครับ

[snasui]

ขอบคูณมากครับ..แต่สูตรยังไม่ใช้ที่ตอบโจทย์ครับ
คืออยากลบ เฉพาะเซลล์ ที่อ้างอิง จาก คอลัม C ไม่ใช่ลบทั้งแถว

จากไฟล์ที่แนบ คือช่อง C7 กับ C9 ว่าง ที่นี้เวลาเรารัน Vba ให้ลบเฉพาะ เซลล์ที่ว่างกับคอลัมที่มีข้อมูลด้วย

ตัวอย่างนะครับ
เช่น C7 ว่าง ให้Vba ลบเซลล C7+D7 +E7 ครับ ไม่ใช่ลบทั้งแถว
ขอบคุณมากครับ

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

Code: Select all

Sub RoundedRectangle1_Click()
    Dim i As Integer, j As Integer
    With Sheets("Sheet1")
        j = .Range("c3", "c9").Rows.Count - 1
        For i = j To 0 Step -1
            If .Range("c3").Offset(i, 0).Value = "" Then
                .Range("c3").Offset(i, 0).Resize(1, 3).Delete shift:=xlUp
            End If
        Next i
    End With
End Sub