时间戳

首页 > 解决方案 > 用于填充工作表的 VBA 循环

excel - 用于填充工作表的 VBA 循环

问题描述

我需要将数据复制到模板中，但我不确定如何创建包含所有范围和单元格的一行以使我的代码更小。现在我用 13 行来填写模板中 20 种产品中的一种。有人能帮忙吗？非常感激

Dim FileName As String
FileName = ""

With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select File"
    .Filters.Add "Excel File", "*.xls?"
    .AllowMultiSelect = False

    If .Show Then
        FileName = .SelectedItems(1)
    End If
End With
If Len(FileName) < 4 Then Exit Sub 'No file selected

Dim TempWorkbook As Workbook, currentSheet As Worksheet
Set currentSheet = ActiveSheet 'Store the ActiveSheet, it will change
Set TempWorkbook = Workbooks.Open(FileName, ReadOnly:=True)

     For Index = 8 To 11

            currentSheet.Range("T" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 2).Address(True, True, xlR1C1, True)
            currentSheet.Range("U" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 4).Address(True, True, xlR1C1, True)
            currentSheet.Range("V" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 9).Address(True, True, xlR1C1, True)
            currentSheet.Range("W" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 13).Address(True, True, xlR1C1, True)
            currentSheet.Range("X" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 17).Address(True, True, xlR1C1, True)
            currentSheet.Range("Y" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 21).Address(True, True, xlR1C1, True)
            currentSheet.Range("Z" & Index).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((Index + 10), 25).Address(True, True, xlR1C1, True)

      Next

新编辑：

Dim FileName As String
FileName = ""

With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select File"
    .Filters.Add "Excel File", "*.xls?"
    .AllowMultiSelect = False

    If .Show Then
        FileName = .SelectedItems(1)
    End If
End With
If Len(FileName) < 4 Then Exit Sub 'No file selected

Dim TempWorkbook As Workbook, currentSheet As Worksheet
Set currentSheet = ActiveSheet 'Store the ActiveSheet, it will change
Set TempWorkbook = Workbooks.Open(FileName, ReadOnly:=True)
Dim TempSheet As Worksheet: Set TempSheet = TempWorkbook.Worksheets("FINAL FORM")
Dim i As Double
Dim Index As Double
Dim arrz As Variant
arrz = Array(2, 4, 9, 13, 17, 21, 25, 29, 30, 36, 37, 38, 39)
For Index = 8 To 11
        For i = 20 To 32
                currentSheet.Cells(Index, i).FormulaR1C1 = "=" & TempSheet.Cells((Index + 10), arrz(i - 39)).Address(True, True, xlR1C1, True)
                currentSheet.Cells((Index + 7), i).FormulaR1C1 = "=" & TempSheet.Cells((Index + 21), arrz(i - 39)).Address(True, True, xlR1C1, True)
        Next i
Next Index
End Sub

标签： excelvba

解决方案

这应该适用于您的要求，看起来更干净：

Dim arr() As Variant, arr2() As Variant
arr = Array(2, 4, 9, 13, 17, 21, 25)

For cl = 20 To 26
    For rw = 8 To 11
        currentSheet.Cells(rw, cl).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((rw + 10), arr(cl - 20)).Address(True, True, xlR1C1, True)
    Next

    For rw = 15 To 18
        currentSheet.Cells(rw, cl).FormulaR1C1 = "=" & TempWorkbook.Worksheets("FINAL FORM").Cells((rw + 14), arr(cl - 20)).Address(True, True, xlR1C1, True)
    Next
Next

推荐阅读