导入数据范围值 - 但不是空白单元格,和/或在目标工作簿中保留公式

问题描述 投票:0回答:2

我有一个源工作簿和一个目标工作簿。源书有一个范围(D13:F293),其中包含数据值以及空白单元格。目标书包含相同的范围,各种单元格包含公式。

我想将数据从源书导入到目标书,但只包含包含值的单元格。此外,如果目标书/单元格包含公式,我想在单元格中保留公式。

我的选择是:

  1. 扫描源空白单元格,仅导入包含数据的单元格。
  2. 扫描公式的目标,如果存在公式,则不要将数据导入该单元格。

我不知道该怎么做。我是VBA的新手,并不完全理解语法。我尝试了3次代码,用空格替换公式,或者给出错误。

此代码将空白单元格复制到目标簿:

Sub TransferData()
   If Workbooks.Count > 1 Then
      Workbooks(2).Sheets("HELOC").Range("D13:F293").Copy
      Workbooks(1).Sheets("HELOC").Range("D13:F293").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Workbooks(2).Close savechanges:=False
   Else
      MsgBox "The data hasn't been transferred.", vbExclamation, "Error"
   End If
End Sub

此代码还将空白单元格复制到目标簿:

Sub TransferData()
   If Workbooks.Count > 1 Then
      For Each cl In ActiveSheet.UsedRange
         If cl.HasFormula() = True Then
            Workbooks(1).Sheets("HELOC").Range("D13:F293") = Workbooks(1).Sheets("HELOC").Range("D13:F293")
         Else
            Workbooks(1).Sheets("HELOC").Range("D13:F293").Value = Workbooks(2).Sheets("HELOC").Range("D13:F293").Value
         End If
      Next cl
      Workbooks(2).Close savechanges:=False
   Else
      MsgBox "The data hasn’t been transferred.", vbExclamation, "Error"
   End If
End Sub

此代码(从here修改)导致:

运行时错误91对象变量或未在行上设置块变量:

“如果mySourceBook.Cells(i,1).Value <>”“那么”

Sub TransferData()
   Dim mySourceBook As Worksheet, myDestinationBook As Worksheet, myBook As Workbook
   Set myBook = Excel.ActiveWorkbook
   Set mySource = myBook.Sheets("HELOC")
   Set myImportData = Excel.ActiveWorkbook.Sheets("HELOC")

   Dim i As Integer, j As Integer 'Define a couple integer variables for counting

   j = 13
   For i = 13 To 293
      If mySourceBook.Cells(i, 1).Value <> "" Then
         myDestinationBook.Cells(j, 2).Value = mySourceBook.Cells(i, 1).Value
         j = j + 1
      End If
   Next i 'This triggers the end of the loop and moves on to the next value of "i".

   Workbooks(2).Close savechanges:=False

   MsgBox "The data hasn’t been transferred.", vbExclamation, "Error"

End Sub

我感谢任何建议。但是,请向我解释,因为我还没有完全理解VBA。

excel vba
2个回答
0
投票

你可以这样做:

Sub MoveIt()

    Dim rngSrc As Range, rngDest As Range, i As Long, cS As Range, cD As Range

    Set rngSrc = Workbooks("Source.xlsx").Worksheets("Sheet1").Range("D13:F293")
    Set rngDest = Workbooks("Target.xlsx").Worksheets("Sheet4").Range("D13:F293")

    For i = 1 To rngSrc.Cells.Count
        Set cS = rngSrc.Cells(i)
        Set cD = rngDest.Cells(i)
        If Len(cS.Value) > 0 And Not cD.HasFormula Then
            cS.Copy cD
            'or
            cD.Value = cS.Value
        End If
    Next i

End Sub

0
投票

我得到了我想要的工作!蒂姆,非常感谢你的帮助!

现在要弄清楚如何导入和保留格式。

Sub TransferData()

Dim rngSrc As Range, rngDest As Range, i As Long, cS As Range, cD As Range

Set rngSrc = Workbooks("Exported AMP Data.xlsx").Worksheets("HELOC").Range("D13:F293")
Set rngDest = Workbooks(1).Worksheets("HELOC").Range("D13:F293")

For i = 1 To rngSrc.Cells.Count
    Set cS = rngSrc.Cells(i)
    Set cD = rngDest.Cells(i)
    If Len(cS.Value) > 0 Then
        cS.Copy cD
        'or
        cD.Value = cD.Value
    End If
Next i
End If
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.