删除“NULL”值的代码

Question

让我快速介绍一下我们的流程是什么：

我将报告导出到 Excel 中（我们将此工作簿称为“原始数据”）。我在导入的文件上运行 Extract 宏：

Sub Extract_Sort_1601_January()
'
Dim ANS As Long

ANS = MsgBox("Is the January 2016 Swivel Master File checked out of SharePoint and currently open on this desktop?", vbYesNo + vbQuestion + vbDefaultButton1, "Master File Open")
If ANS = vbNo Or IsWBOpen("Swivel - Master - January 2016") = False Then
    MsgBox "The required workbook is not currently open. Please open the correct file and restart the Extract process. This procedure will now terminate.", vbOKOnly + vbExclamation, "Terminate Procedure"
    Exit Sub
End If

    Cells.EntireRow.Hidden = False

Application.ScreenUpdating = False

    ' This line autofits the columns C, D, O, and P
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit

Dim LR As Long

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & LR).Value <> "1" Then
            Rows(LR).EntireRow.Delete
        End If
    Next LR

With ActiveWorkbook.Worksheets("Extract").Sort
    With .SortFields
        .Clear
        .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("D2:D2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("O2:O2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("J2:J2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("K2:K2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("L2:L2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:Z2000")
    .Apply
End With
Cells.WrapText = False
Sheets("Extract").Range("A2").Select

    Dim LastRow As Integer, i As Integer, erow As Integer

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        If Cells(i, 2) = "1" Then

            ' As opposed to selecting the cells, this will copy them directly
            Range(Cells(i, 1), Cells(i, 26)).Copy

            ' As opposed to "Activating" the workbook, and selecting the sheet, this will paste the cells directly
            With Workbooks("Swivel - Master - January 2016.xlsm").Sheets("Swivel")
                erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                .Cells(erow, 1).PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
        End If
    Next i

Application.ScreenUpdating = True
End Sub

这会将“提取”文件中的数据复制到另一个工作簿（该工作簿称为“Swivel”）。这部分成功完成。完成后，在“Swivel”工作簿中，我们运行删除重复宏：

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(10, 11, 12, 13, 14, 15, 16), Header:=xlYes
    ActiveWindow.SmallScroll Down:=6

Range("C" & Rows.Count).End(xlUp).Offset(1).Select

Application.ScreenUpdating = True

End Sub

在将数据复制到“Swivel”工作簿和运行 Remove Duplicates 宏之间的某个位置，在刚刚粘贴的行中的 AD 列中的单元格中插入了一个空值（我认为）。我只知道这一点，因为此代码正在工作表中运行以进行更改：

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim r As Range
Set r = Target.EntireRow

    If Target.row = 1 Then Exit Sub ' Don’t change header color

    If r.Cells(1, "AD").Value <> "" Then 
        r.Font.Color = RGB(0, 176, 80)
    Else
        r.Font.ColorIndex = 1
    End If
End Sub

为了澄清，这里是上述潜艇所在的位置：

Extract_Sort_1601_January 是我为“原始数据”文件创建的插件的一部分。

Remove_Duplicates 位于“Swivel”工作簿的一个模块中。

WorkSheet_Change 位于“Swivel”工作簿的 Sheet1 对象中。

1. 报告网站的数据导出到“原始数据”工作簿
2. Extract_Sort_1601_January 将数据复制到现有的“Swivel”中 工作簿（在这种情况下，工作簿名称为“Swivel - Master - 2016 年 1 月.xlsm")
3. Remove_Duplicates 在“旋转”工作簿上启动。

如果“旋转”工作簿的 AD 列中没有数据，则该行中的文本应为黑色。但是，在运行 Remove Duplicates 宏后情况并非如此，文本是绿色的。如果我转到该行中的“空”单元格（AD 列）并单击删除，则该行将变为黑色文本。我还检查了单元格中是否有空格，但没有。如何编码删除使工作表更改子相信单元格中有值的“空”值？而且，这可以添加到“删除重复项”子项中吗？

感谢大家的帮助！

Answer 1

我们从内部站点提取文件。我注意到报告团队已更改他们在报告工具实例中的偏好，以使用 Excel XP/2003 版本设置导出文件。我编译的所有代码都使用相同的报告，但使用的是 2007 年和更新的格式。一旦更改了此偏好更改以使报告团队使用 2007 年及更新版本进行导出，此问题已得到纠正。所以最后，代码很好，没有鬼。这证明了沟通和变更管理是极好的工具。感谢所有试图帮助解决这个问题的人。非常感谢您的所有努力。

Answer 2

测试这段代码：

Sub test()

Dim LastRow As Long
dim i as long
LastRow = 100 'change this to the last row (if it work)
Application.EnableEvents = True

 For i = 2 To LastRow
  If Trim(Range("AD" & i).Value) = "" Then Range("AD" & i).ClearContents
 Next

End Sub

Answer 3

问题在于工作表中有很多“假空”单元格。我无法弄清楚这些来自哪里，但我找到了这段代码并将其集成到 ClearContents 的 Remove_Duplicates 子中：

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

Dim usedrng As Range

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(10, 11, 12, 13, 14, 15, 16), Header:=xlYes

    For Each usedrng In ActiveSheet.UsedRange
        If usedrng.Value = "" Then
            usedrng.ClearContents
        End If
    Next

Range("C" & Rows.Count).End(xlUp).Offset(1).Select

Application.ScreenUpdating = True

End Sub

所以现在，这段代码按预期工作：

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim r As Range
Set r = Target.EntireRow

    If Target.row = 1 Then Exit Sub ' Don’t change header color

    If r.Cells(1, "AD").Value <> "" Then 
        r.Font.Color = RGB(0, 176, 80)
    Else
        r.Font.ColorIndex = 1
    End If
End Sub

感谢所有帮助我走到这一步的人。