Question

下午好，伙计们，

我一直在努力将一些excel宏从一个非常旧的宏设置更新到VBA宏。我不太确定我正在寻找什么，如何解决这些，因为我最近才开始学习VBA。我遇到的问题最多的是从指定的工作簿中获取信息，将其插入当前工作簿，并且不会覆盖公式。 “HEAT5.XLSX”是将获取信息的主文件。原始宏是这样的：
`

Open (o)
=PROTECT.DOCUMENT(FALSE,FALSE,,FALSE)
=OPEN(!F1)
=PROTECT.DOCUMENT(FALSE,FALSE,,FALSE)
=WINDOW.TITLE(!F1)
=SELECT("R1C3:R37C4")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R1C3")
=PASTE()
=ACTIVATE(!F1)
=SELECT("R2C6:r6c6")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R2C6")
=PASTE()
=ACTIVATE(!F1)
=SELECT("R1C14")
=COPY()
=ACTIVATE("HEAT5.XLSX")
=SELECT("R2C14")
=PASTE()
=ACTIVATE(!F1)
=PROTECT.DOCUMENT(TRUE,FALSE,,TRUE)
=CLOSE(TRUE)
=ACTIVATE("HEAT5.XLSX")
=SELECT("R1C6")
=PROTECT.DOCUMENT(TRUE,FALSE,,TRUE)
=RETURN()`

到目前为止我试图重新创建的是：

`Sub Retrieve()
    Dim strFName As String

    strFName = ThisWorkbook.Path & "\" & Sheet1.Range("F1").Value & ".xlsx"
    'this variable contains the workbook name and path
    If FileExists(strFName) Then
    'does it exist?
        If Not BookOpen(Dir(strFName)) Then Workbooks.Open Filename:=strFName
        'if its not already open, open it
    Else
        MsgBox "The file does not exist!"
    End If

End Sub

Function FileExists(strfullname As String) As Boolean
    FileExists = Dir(strfullname) <> ""
End Function

Function BookOpen(strWBName As String) As Boolean
    Dim wbk As Workbook
    On Error Resume Next
    Set wbk = Workbooks(strWBName)
    If Not wbk Is Nothing Then BookOpen = True
End Function`

非常感谢任何建议和协助。谢谢大家。

Answer 1

不确定你的意思是“不会覆盖公式”，但为什么不试试这个而不是你得到的？你的看起来有点混乱。

Dim wbk as Workbook
Dim wbk2 as Workbook
Set wbk as Thisworkbook 'this one will be HEAT.xlsx
Set wbk2 as Workbooks.Open("FILENAME.xlsx")

wbk2.Activate    'makes FILENAME.xlsx your active workbook
Sheets("Sheet1").Range(Cells(1,3),Cells(37,4)).Select
Application.CutCopyMode = False
Selection.Copy

wbk.Activate
Sheets("Sheet1").Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

wbk2.Activate
Sheets("Sheet1").Range(Cells(2,6),Cells(6,6).Select
Application.CutCopyMode = False
Selection.Copy

wbk.Activate
Sheets("Sheet1").Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

并在剩下的选择中重复此过程。单元格功能如下：

Cells(row number, column number)

Excel VBA宏用于打开信息并将信息从一个工作簿加载到另一个工作簿

1 个答案: