循环和偏移

时间:2014-02-04 20:33:02

标签: excel vba excel-vba

我是vba和这个网站的新手,需要一些指导。我正试图从另一张纸上读取动态创建的范围。使用此范围将其填充到另一个工作表中,在该范围中的每一行之后具有四行的偏移量。偏移量创建的每一行都应插入一个字符串值。

例如

1000                      /populated from range
sting insert              /populated from offset 1 
another string insert     /populated from offset 2
a final string insert     /populated from offset 3

更新前:

2000    ACCOUNT NAME
2001    ACCOUNT NAME
2002    ACCOUNT NAME
2003    ACCOUNT NAME

更新后:

2000    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

2001    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

2002    ACCOUNT NAME
    new string 1
    new string 2
    new string 3

我尝试了几种不同的方法,但没有任何方法按照我的方式工作。下面的代码在获取范围和填充目标表时按预期工作,但偏移量令我头疼。任何帮助/指导将不胜感激。

到目前为止

代码。

 Sub Program_Array()
    Dim rngToCopy As Range
    Dim C As Range
    Dim varArray As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim LastRow As Long

     Set ws1 = Sheets("Index")
     Set ws2 = Sheets("FinalSheet")

        LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

            With ThisWorkbook
              et rngToCopy = .Worksheets("Index").Range("A2", ws1.Cells(LastRow, "A"))
              varArray = rngToCopy.Value

              For Each C In rngToCopy
              C.Offset(3, 0).Value = C.Value
              Next C

              ws2.Range("A5").Resize(UBound(varArray, 1), UBound(varArray, 2)).Value = varArray

            End With

        Set rngToCopy = Nothing: Set ws1 = Nothing: Set ws2 = Nothing

    End Sub

1 个答案:

答案 0 :(得分:1)

如果我理解正确,您希望在最终表格上进行更新吗?试试这个:

Sub Program_Array()
Dim rngToCopy As Range
Dim C As Range
Dim varArray As Variant
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim i As Long

Set ws1 = Sheets("Index")
Set ws2 = Sheets("FinalSheet")

    LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

      Set rngToCopy = ws1.Range("A2", ws1.Cells(LastRow, "A"))
      Set rngFinal = ws2.Range("A2", ws2.Cells(LastRow * 4, "A"))

      For i = 1 To rngToCopy.Rows.Count
        rngFinal((i - 1) * 4 + 1, 1) = rngToCopy(i, 1)
        rngFinal((i - 1) * 4 + 2, 1) = "string 1"
        rngFinal((i - 1) * 4 + 3, 1) = "string 2"
        rngFinal((i - 1) * 4 + 4, 1) = "string 3"

      Next i

End Sub

编辑:或者如果你真的想使用偏移量:

Dim LastRow As Long
Dim i As Long

Set ws1 = Sheets("Index")
Set ws2 = Sheets("FinalSheet")

    LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

      Set rngToCopy = ws1.Range("A2", ws1.Cells(LastRow, "A"))
      Set rngFinal = ws2.Range("A1")

      For i = 1 To rngToCopy.Rows.Count
        rngFinal.Offset((i - 1) * 4 + 1, 0) = rngToCopy(i, 1)
        rngFinal.Offset((i - 1) * 4 + 2, 0) = "string 1"
        rngFinal.Offset((i - 1) * 4 + 3, 0) = "string 2"
        rngFinal.Offset((i - 1) * 4 + 4, 0) = "string 3"

      Next i

End Sub