如何在真正的空白单元格上进行查找和替换

Question

我有一个范围，它的大小可以变化，并且可以包含数万个单元格。 对于这个范围内每个有字符串的单元格，我需要用 1 替换。对于根本没有值的每个单元格，我需要用零替换。

我尝试了以下方法，但是虽然它确实将填充的单元格替换为单元格，但空白单元格仍然是空白的。

Selection.Replace What:="*", Replacement:="1", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

我也试过这个，结果是一样的。

Selection.Replace What:=null, Replacement:="0", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

编辑：包含完整代码

Sub MassFindReplace()

        ' This will select an area within the given parameters and replace all blank cells with zeros and all populated cells with Ones

    Dim VRange1 As String
    Dim VRange2 As String
    Dim Doublecheck As Integer

    VRange1 = InputBox("Enter First Cell Address Here" & vbNewLine & vbNewLine & "Make sure you ONLY input a single cell address")

    VRange2 = InputBox("Enter Second Cell Address Here" & vbNewLine & vbNewLine & "Make sure you ONLY input a single cell address")

    Range(VRange1, VRange2).Select

    Doublecheck = MsgBox("The range you have selected is between " & VRange1 & " and " & VRange2 & vbNewLine & vbNewLine & "Does this sound right to you?" & vbNewLine & vbNewLine & "If not press No to cancel", vbYesNo)

    If Doublecheck = vbYes Then

    ' This turns off a number of background functions and greatly speeds up this process
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' choose what to search for and what to replace with here
    Selection.Replace What:="*", Replacement:="1", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Selection.Cells.SpecialCells(xlCellTypeBlanks).Value = 1


    'Resets the background functions. THIS MUST HAPPEN or it will screw up your excel.
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.CalculateFull

    MsgBox "Complete"

    Else
        MsgBox "Canceled"

    End If

End Sub

编辑：我尝试在下面的一些代码之后基于此，但虽然它似乎有效，但我无法让它选择自定义范围。

Sub MassTEST()



Dim ws As Worksheet: Set ws = ActiveSheet
Dim cel As Range
Dim VRange1 As String
Dim VRange2 As String
Dim Doublecheck As Integer


VRange1 = InputBox("Enter First Cell Address Here" & vbNewLine & vbNewLine & "Make sure you ONLY input a single cell address")

VRange2 = InputBox("Enter Second Cell Address Here" & vbNewLine & vbNewLine & "Make sure you ONLY input a single cell address")

Data = ws.Range(VRange1, VRange2).Value

For Each cel In ws.UsedRange
    If cel.Value <> "" Then
        cel.Value = 1
    Else
        cel.Value = 0
    End If
Next

结束子

Answer 1

使用这个：

On Error Resume Next
    Selection.Cells.SpecialCells(xlCellTypeBlanks).Value = 1
On Error GoTo 0

注意它只会填充 UsedRange 和 Selected Cells 的交集。

Answer 2

如果您必须遍历并评估每个单元格，则只需检查每个单元格以查看其是否为空。当然，如果工作表的 UsedRange 不是您需要的范围，您可以手动指定它。

Sub MassFindReplace()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim cel As Range

    For Each cel In ws.UsedRange
        If cel.Value <> "" Then
            cel.Value = 1
        Else
            cel.Value = 0
        End If
    Next

End Sub

根据 urdearboy 的建议，您也可以将其加载到数组中，然后在那里检查。

Sub MassFindReplace()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim data As Variant, v As Variant

    data = ws.UsedRange.Value

    For i = LBound(data, 1) To UBound(data, 1)
        For j = LBound(data, 2) To UBound(data, 2)
            If data(i, j) <> "" Then
                 data(i, j) = 1
            Else
                data(i, j) = 0
            End If
        Next
    Next

    ws.UsedRange.Resize(UBound(data, 1), UBound(data, 2)).Value = data

End Sub

Answer 3

使用“~*”。

Selection.Replace What:="~*", Replacement:="1", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False