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

这会将“extract”文件中的数据复制到另一个工作簿中（此工作簿称为“Swivel”）。这部分成功完成。完成此操作后，在“Swivel”工作簿中，我们将运行remove duplicates宏：

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对象中。

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

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

感谢您的帮助！

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

问题在于，有很多假的空白＆＃34;工作表中的单元格。我无法弄清楚这些来自何处，但我找到了这段代码并将其集成到 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

感谢所有帮助我实现这一点的人。

用于删除“NULL”值的代码

3 个答案: