Как найти и заменить действительно пустые ячейки

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

End Sub

Answer 1

Если вам нужно пройти и оценить КАЖДУЮ ячейку, просто проверьте каждую ячейку, чтобы убедиться, что она пустая. Конечно, если 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 2

Используйте "~ *".

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

Answer 3

используйте это:

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

Обратите внимание, что он заполнит только пересечение между Использованным диапазоном и Выбранными ячейками.