Xóa số 0 theo điều kiện? (1 người xem)

[Hoàng Nhật Phương]

Xin chào các bạn,
Nhờ các bạn giúp đỡ tôi xóa các số 0 theo điều kiện nêu trong file đính kèm với ạ.

 

[be_09]

Xin chào các bạn,
Nhờ các bạn giúp đỡ tôi xóa các số 0 theo điều kiện nêu trong file đính kèm với ạ.

Không hiểu, nếu chỗ nào không có giá trị thì không cho hiện số 0 thì làm vầy:
Vào File > Options rồi làm như hình (xóa dấu check tại Show a zero......).

 

[huuthang_bd]

Xin chào các bạn,
Nhờ các bạn giúp đỡ tôi xóa các số 0 theo điều kiện nêu trong file đính kèm với ạ.

Bạn thử xem:

Sub RunMe()
Dim DicNCC As Object, ArrRuler1 As Variant, ArrRuler2 As Variant, ArrData1 As Variant, ArrData2 As Variant, EndR As Long, i As Long
Set DicNCC = CreateObject("Scripting.Dictionary")
ArrRuler1 = Range("B6:B9").Value
ArrRuler2 = Range("E6:AI9").Value
EndR = Cells(&H100000, 2).End(xlUp).Row
ArrData1 = Range("B15:B" & CStr(EndR)).Value
ArrData2 = Range("E15:AI" & CStr(EndR)).Value
For i = 1 To UBound(ArrRuler2, 2)
    DefineDic DicNCC, ArrRuler1, ArrRuler2, i
    Clear0 DicNCC, ArrData1, ArrData2, i
Next
Range("E15:AI" & CStr(EndR)).Value = ArrData2
End Sub
Private Sub DefineDic(ByRef DicNCC As Object, ByRef ArrNCC As Variant, ByRef ArrData As Variant, ByVal Col As Long)
Dim i As Long
DicNCC.RemoveAll
For i = 1 To UBound(ArrNCC, 1)
    If ArrData(i, Col) = "X" Then
        DicNCC.Add ArrNCC(i, 1), 0
    End If
Next
End Sub
Private Sub Clear0(ByRef DicNCC As Object, ByRef ArrNCC As Variant, ByRef ArrData As Variant, ByVal Col As Long)
Dim i As Long
If DicNCC.Count = 0 Then Exit Sub
For i = 1 To UBound(ArrNCC, 1)
    If DicNCC.Exists(ArrNCC(i, 1)) Then
        If ArrData(i, Col) = 0 Then ArrData(i, Col) = Empty
    End If
Next
End Sub

@be09: Xóa có điều kiện.

 

[Hoàng Nhật Phương]

Bạn thử xem:

Sub RunMe()
Dim DicNCC As Object, ArrRuler1 As Variant, ArrRuler2 As Variant, ArrData1 As Variant, ArrData2 As Variant, EndR As Long, i As Long
Set DicNCC = CreateObject("Scripting.Dictionary")
ArrRuler1 = Range("B6:B9").Value
ArrRuler2 = Range("E6:AI9").Value
EndR = Cells(&H100000, 2).End(xlUp).Row
ArrData1 = Range("B15:B" & CStr(EndR)).Value
ArrData2 = Range("E15:AI" & CStr(EndR)).Value
For i = 1 To UBound(ArrRuler2, 2)
    DefineDic DicNCC, ArrRuler1, ArrRuler2, i
    Clear0 DicNCC, ArrData1, ArrData2, i
Next
Range("E15:AI" & CStr(EndR)).Value = ArrData2
End Sub
Private Sub DefineDic(ByRef DicNCC As Object, ByRef ArrNCC As Variant, ByRef ArrData As Variant, ByVal Col As Long)
Dim i As Long
DicNCC.RemoveAll
For i = 1 To UBound(ArrNCC, 1)
    If ArrData(i, Col) = "X" Then
        DicNCC.Add ArrNCC(i, 1), 0
    End If
Next
End Sub
Private Sub Clear0(ByRef DicNCC As Object, ByRef ArrNCC As Variant, ByRef ArrData As Variant, ByVal Col As Long)
Dim i As Long
If DicNCC.Count = 0 Then Exit Sub
For i = 1 To UBound(ArrNCC, 1)
    If DicNCC.Exists(ArrNCC(i, 1)) Then
        If ArrData(i, Col) = 0 Then ArrData(i, Col) = Empty
    End If
Next
End Sub

@be09: Xóa có điều kiện.

Xin chào huuthang_bd

Xin cảm ơn anh rất nhiều,mới đầu chạy Oanh Thơ thấy tuyệt vời rồi anh ạ.
Oanh Thơ sẽ kiểm tra lại thêm, nếu có vấn đề gì rất mong tiếp tục nhận được sự hỗ trợ của anh và các bạn ạ.

 

[ndu96081631]

Bài này thấy làm bằng Autofilter cũng ra. Nguyên tắc:
- Quét từ dòng 5 đến dòng 9 (quét từng dòng) trong khu vực E5:AI9
- Dùng SpecialCells định vị các cells có nội dung
- Xong "chiếu" xuống dòng 15, dùng Find and Replace xóa số 0

Sub test()
  Dim rngFilter As Range, rngTarget As Range, rngSource As Range, cel As Range
  Set rngSource = Sheet1.Range("B14:AI2000")
  Set rngFilter = Sheet1.Range("B6:B9")
  For Each cel In rngFilter
    rngSource.AutoFilter 1, cel.Value
    On Error Resume Next
    Set rngTarget = cel.Offset(, 3).Resize(, 31).SpecialCells(xlCellTypeConstants).EntireColumn
    If Not rngTarget Is Nothing Then
      On Error GoTo 0
      Set rngTarget = Intersect(rngTarget, rngSource.Offset(1))
      rngTarget.Replace 0, Empty, xlWhole
    End If
  Next
  Sheet1.AutoFilterMode = False
End Sub

 

[huuthang_bd]

Bài này thấy làm bằng Autofilter cũng ra. Nguyên tắc:
- Quét từ dòng 5 đến dòng 9 (quét từng dòng) trong khu vực E5:AI9
- Dùng SpecialCells định vị các cells có nội dung
- Xong "chiếu" xuống dòng 15, dùng Find and Replace xóa số 0

Sub test()
  Dim rngFilter As Range, rngTarget As Range, rngSource As Range, cel As Range
  Set rngSource = Sheet1.Range("B14:AI2000")
  Set rngFilter = Sheet1.Range("B6:B9")
  For Each cel In rngFilter
    rngSource.AutoFilter 1, cel.Value
    On Error Resume Next
    Set rngTarget = cel.Offset(, 3).Resize(, 31).SpecialCells(xlCellTypeConstants).EntireColumn
    If Not rngTarget Is Nothing Then
      On Error GoTo 0
      Set rngTarget = Intersect(rngTarget, rngSource.Offset(1))
      rngTarget.Replace 0, Empty, xlWhole
    End If
  Next
  Sheet1.AutoFilterMode = False
End Sub

Anh thiếu dòng Set rngTarget = Nothing. Kết quả không sai nhưng một vùng được thực hiện nhiều lần không cần thiết.