如何使 vba 代码按行自动更新？答案

【问题标题】：How to make the vba code to auto update by row?如何使 vba 代码按行自动更新？
【发布时间】：2014-07-09 12:12:42
【问题描述】：

我在一个文件夹中有很多文件，

我的代码如下，有什么方法可以简化我的代码，这样我就不需要继续复制和粘贴相同的代码，而是继续更新行号？

Sub FetchData()
Dim wbSource As Workbook
Dim shSource As Worksheet
Dim shDestin As Worksheet
Application.ScreenUpdating = False

'trace file from file path on B12
Workbooks.Open Filename:=Range("B12").Value & Sheets("Sheet1").Range("A1")
Set wbSource = ActiveWorkbook
Set shSource = wbSource.Sheets("Sheet1")

'current sheet display
Set shDestin = ThisWorkbook.Sheets("Sheet1")

'shDestion.Range display at where shSource.Range: the track data frm other file (NI)
shDestin.Range("E12") = shSource.Range("C2")
shDestin.Range("F12") = shSource.Range("D2")
shDestin.Range("G12") = shSource.Range("E2")

'shDestion.Range display at where shSource.Range: the track data frm other file (PD)
shDestin.Range("N12") = shSource.Range("C3")
shDestin.Range("O12") = shSource.Range("D3")
shDestin.Range("P12") = shSource.Range("E3")

 'shDestion.Range display at where shSource.Range: the track data frm other file (AU)
  shDestin.Range("W12") = shSource.Range("C4")
  shDestin.Range("X12") = shSource.Range("D4")
  shDestin.Range("Y12") = shSource.Range("E4")

‘copy from another workbook where filepath is at B11
Workbooks.Open Filename:=Range("B11").Value & Sheets("Sheet1").Range("A4")
Set wbSource = ActiveWorkbook
Set shSource = wbSource.Sheets("Sheet1")

'current sheet display
Set shDestin = ThisWorkbook.Sheets("Sheet1")

'shDestion.Range display at where shSource.Range: the track data frm other file (NI)
shDestin.Range("E11") = shSource.Range("C2")
shDestin.Range("F11") = shSource.Range("D2")
shDestin.Range("G11") = shSource.Range("E2")

   'shDestion.Range display at where shSource.Range: the track data frm other file (PD)
  shDestin.Range("N11") = shSource.Range("C3")
  shDestin.Range("O11") = shSource.Range("D3")
  shDestin.Range("P11") = shSource.Range("E3")

  'shDestion.Range display at where shSource.Range: the track data frm other file (AU)
  shDestin.Range("W11") = shSource.Range("C4")
  shDestin.Range("X11") = shSource.Range("D4")
  shDestin.Range("Y11") = shSource.Range("E4")

wbSource.Close False
End Sub

【问题讨论】：

您要复制/粘贴哪段代码？全部还是部分？您指的行号在哪里？是在代码中还是在 Excel 工作表中？
当然有一些方法可以优化这个，例如你可以做shDestin.Range("E12:G12") = shSource.Range("C2:E2")等，但我认为如果你需要在循环/重复中这样做，还有进一步的改进空间.
代码在Excel文件中，我设置了一个按钮来跟踪多个文件中的一些数据。行号将是我希望 shDestin.Range 行号的行号。我可以做一个循环吗？
当我输入 shDestin.Range("E12:G12") = shSource.Range("C2:E2") 时，显示类型不匹配。
您的问题陈述不清楚。您需要使用循环。但我不排除完全没有任何 VBA 就可以做到这一点的可能性。此外，对于诸如 shDestin.Range("E11") = shSource.Range("C2") 之类的语句，您需要使用 shDestin.Range("E11").value = shSource.Range("C2")。否则它会抛出一个错误。

标签： vba excel excel-2010 file-copying

【解决方案1】：

类似这样的东西，但很难在您发布的代码中准确说出您在做什么......

例如，当您启动此代码时，Activesheet 是什么？

Option Explicit

Sub FetchData()

    Dim shDestin As Worksheet

    Application.ScreenUpdating = False

    Set shDestin = ThisWorkbook.Sheets("Sheet1")

    CopyFileContent Range("B12").Value & shDestin.Range("A1").Value, _
                    shDestin, 12

    CopyFileContent Range("B11").Value & shDestin.Range("A4").Value, _
                    shDestin, 11

End Sub


Sub CopyFileContent(filePath As String, destSheet As Worksheet, destRow As Long)

    Dim wbSource As Workbook, shSource As Worksheet, rngDest As Range

    Set wbSource = Workbooks.Open(Filename:=filePath)
    Set shSource = wbSource.Sheets("Sheet1")

    Set rngDest = destSheet.Cells(destRow, 5).Resize(1, 3)
    rngDest.Value = shSource.Range("C2:E2").Value
    rngDest.Offset(0, 9).Value = shSource.Range("C3:E3").Value
    rngDest.Offset(0, 18).Value = shSource.Range("C4:E4").Value

    wbSource.Close False
End Sub

【讨论】：

嗨，它有效！非常感谢。但是我能知道 rngDest.Offset(0, 9).Value 是什么意思吗 rngDest.Offset(0, 18).Value 谢谢。
rngDest 是一个范围变量，它引用“E{r}:F{r}”，其中 {r} 是传递给过程的行号。 rngDest.Offset(0, 9) 指的是其右侧的 9 列范围（在同一行上）。范围的Value 是一个二维值数组，可以直接分配给另一个相同大小和方向的范围。
感谢您的解释。我想知道如果 B12 上的文件路径为空，是否有任何方法使其不运行 CopyFileContent 函数？因为如果我继续使用该代码，如果检测到 B12 为空，则会出现错误。 IsEmpty() 是否可以帮助处理代码？
你可以使用类似If Len(Range("B12").Value) > 0 Then
您好，我修改如下代码后没有任何结果，没有错误，但没有数据被追踪 If Len(Range("B12").Value) > 0 Then Set wbSource = Workbooks.Open(Filename:=filePath) Set shSource = wbSource.Sheets("Sheet1")