Question

我使用以下代码：

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

这可以正常使用，但我需要约束粘贴的范围。运行此代码时，它会复制A2：Z2的范围（此问题的样本范围，它实际上会复制比此更多的行），但它会粘贴到Z列以外的单元格。我最关心的是AD列，因为有代码当有一个值插入该列时，将该行的文本更改为绿色。运行复制/粘贴代码后，即使AD中没有任何内容，该行也会更改为绿色文本。下面是将行中的文本更改为绿色的代码（此代码位于工作簿的Sheet1对象中）。

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

现在，在我们完成工作的行的列AD中，我们以这种格式插入日期和时间：1/4/2016 13:20。我可以更改此行：

If r.Cells(1, "AD").Value <> "" Then

检查格式而不是值？

我还在学习VBA，但知道我有很多需要学习的东西。任何帮助表示赞赏。

编辑：在运行此代码之后才会出现异常（位于目标工作簿＆＃34; Swivel＆＃34;）

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

这会将文本更改为绿色，但该行的列AD中没有任何内容可以触发更改。

Answer 1

因为我在这里问到的唯一问题是：

我可以更改此行：如果r.Cells（1，“AD”）。值＆lt;＆gt; “”那么

检查格式而不是值？

这是一种方法：

Me.Cells(Target.Row,30).Activate 'column 30 for AD
If Application.ExecuteExcel4Macro("GET.CELL(7)") = "m/d/yyyy h:mm;@" Then

将格式调整为完全需要。我只是根据你问题中的信息猜到了。

Answer 2

我没有尝试在Worksheet_Change子中解决这个问题，而是将Remove_Duplicates子修改为：

Sub Remove_Duplicates()
'
Application.ScreenUpdating = False

Dim usedrng As Range

    ActiveSheet.Range("$A$1:$Z$2000").RemoveDuplicates Columns:=Array(5, 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

这已经删除了我有效竞争的假空值。 WorkSheet_Change子现在可以在上面的初始问题中编写，并且工作表的行为与添加新行数据时的行为相同，即文本应保持黑色，直到在AD列中输入日期/时间为止那一行。

感谢所有提供帮助的人。我希望这个答案能帮助其他人。

修改数据粘贴（约束范围）

2 个答案: