删除 'NULL' 值的代码

Question

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

我将报告导出到 Excel（我们称此工作簿为 "Raw Data"）。我运行导入文件上的提取宏：

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

这会将数据从 "extract" 文件复制到另一个工作簿（此工作簿称为 "Swivel"）。这部分成功完成。完成后，在 "Swivel" 工作簿中，我们然后运行删除重复宏：

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

    ActiveSheet.Range("$A:$Z00").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' 工作簿和运行删除重复项宏之间的某处，有一个空值（我认为）插入到行中 AD 列的单元格中刚粘贴进来。我只知道这个是因为此代码运行ning 在工作表中以供更改：

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 是我为 "raw data" 文件创建的插件的一部分。

Remove_Duplicates 在 "Swivel" 工作簿的模块中。

WorkSheet_Change 在 "Swivel" 工作簿的 Sheet1 对象中。

来自报告站点的数据已导出到 "raw data" 工作簿
Extract_Sort_1601_January 将数据复制到现有 "Swivel" 工作簿（在这种情况下，工作簿名称是“Swivel - Master - 一月 2016.xlsm")
Remove_Duplicates 在 "Swivel" 工作簿上启动。

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

感谢大家的帮助！

Answer 1

测试这段代码：

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 2

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

Answer 3

问题是工作表中有很多 "fake empty" 个单元格。我无法弄清楚这些是从哪里来的，但我找到了这段代码并将其集成到 ClearContents:

的 Remove_Duplicates 子项中

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

Dim usedrng As Range

    ActiveSheet.Range("$A:$Z00").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

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

删除 'NULL' 值的代码

Code to remove 'NULL' values

excel

vba

excel-2007