Question

我有以下代码以插入新行并填充数据。如果我只是运行代码它运行正常，但我只希望它运行，如果日期不在列中，所以我把它包含在IF语句中，但它无法执行：

Sub PasteValues()

    If Not IsError(Application.Match(Sheet10.[A1], Sheet6.[B1:65000], 0)) Then
        Rows("4:4").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B4").Select
        ActiveCell.FormulaR1C1 = "=LastUpdate!R[-3]C[-1]"
        Range("C5:AP5").Select
        Selection.Copy
        ActiveWindow.ScrollColumn = 1
        Range("C4").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Selection.Copy
        Range("B4:AP4").Select
        Application.CutCopyMode = False
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      End If

End Sub

Answer 1

你可以尝试这个，关键是使用通用例程：

Sub Main()

    '//1.  find the last row of data rather than an arbituary row number.  Give your data range a name,
    '//    such as dataRange
    Dim lngLastRow  As Long
    Dim lngDataRow  As Long
    Dim dtMyDate    As Date
    Dim strTempAddr As String

    dtMyDate = ThisWorkbook.Worksheets("Sheet10").Range("A1").Value
    lngLastRow = FindLastRow(Range("dataRange").Address)
    strTempAddr = "B1:B" & lngLastRow
    lngDataRow = FindAddress(ThisWorkbook, "Sheet6", dtMyDate, strTempAddr)

    If lngDataRow = 0 Then
      '//value 0 means Date is not present so...
      '//do your row insert and data population.
    End If

End Sub

目的：找到连续细胞区域的最后一卷，即区域中的NO空白

它的形式，例如：$D$11:$E$33

Function FindLastRow(strCurrentRegion As String) As Long
    Dim rowAdd       As String
    Dim lngLastRow   As Long

    rowAdd = Right$(strCurrentRegion, Len(strCurrentRegion) - (InStr(strCurrentRegion, ":") + 1))
    lngLastRow = Right$(rowAdd, Len(rowAdd) - InStr(rowAdd, "$"))
    FindLastRow = lngLastRow

End Function

目的：在用户指定的范围内找到您要查找的值

Function FindAddress(ByRef oWkbk As Workbook, ByRef strWkshName As String, ByVal dtFindMyDate As Date, _
              ByRef strRangeToLookIn As String) As Long

    Dim oRange   As Range

    With oWkbk.Worksheets(strWkshName).Range(strRangeToLookIn)
      Set oRange = .Find(dtFindMyDate, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

      If oRange Is Nothing Then
         FindAddress = 0
      Else
         FindAddress = oRange.Row
      End If

    End With

End Function

希望有所帮助。

Answer 2

下面的代码更新示例，我只需要更改引用单元格的方式：

Sub PasteValues()

     Dim LookupValue As String

     Dim LookupRange As Range

     Set LookupRange = Sheets("Sheet6").Range("B1:B65000")

     LookupValue = Sheets("Sheet10").Range("A1").Value

     If Not IsError(Application.Match(LookupValue, LookupRange, 0)) Then

          your code...

     End If

end sub

Answer 3

也许尝试这样的事情：

Sub PasteValues()

Dim fRange as Range
Dim fVal as String

fVal = Sheets("Sheet10").Range("A1").Value

Set fRange = Sheets("Sheet6").Range("B1:B65000").Find(What:=fVal, After:=Range("B1"), LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)

If Not fRange Is Nothing Then
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=LastUpdate!R[-3]C[-1]"
    Range("C5:AP5").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 1
    Range("C4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Range("B4:AP4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  End If

End Sub

在if语句中，Excel VBA代码不会执行

3 个答案: