Question

我在VBA中有一个代码，该代码将2列现有值复制到另一张工作表的相似数据下。我想稍微将VBA代码更改为，如果值另一个单元格（C3）的单元格为TRUE，则它将该数据复制到现有数据的开头（开头为A1和B1）。我在工作表中有此数据：

-Q-  -R-
156  F5
486  T9
695  H3

我在另一个工作表中已有一个数据：

-A-  -B-
695  E6
326  T8
326  Q9

如果另一张纸上的C3值为TRUE，则需要在现有值之前粘贴新值

-A-  -B-
156  F5
486  T9
695  H3
695  E6
326  T8
326  Q9

我有将数据复制到existi8ng数据末尾的代码，我只需要扩展它即可将数据插入到数据的开头，如果C3实质上将所有现有值都移到新值以下是真的。（我需要复制的值在“ Nastavit D”工作表（Q和R）中，我需要将其粘贴到“链（A和B）中，而C3 TRUE单元格在” Nedotykat sa！ ”）（如果C3为FALSE，我需要将其复制到现有数据的末尾，而我的代码已经这样做了，而无需C3检查。）

Sub CopyRange()
    Dim x, y(), I As Long, ii As Long

    If Sheets("Nastavit D").[Q2] = "" Then Exit Sub
    x = Sheets("Nastavit D").[Q2:R1000]
    For I = 1 To UBound(x, 1)
        If x(I, 1) <> "" Then
            ReDim Preserve y(1 To 2, 1 To I)
            For ii = 1 To 2
                y(ii, I) = x(I, ii)
            Next
        Else: Exit For
        End If
    Next
    With Sheets("Chain")
        .Cells(.rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 2) = Application.Transpose(y)
    End With

End Sub

Answer 1

未经充分测试，但我想您明白了。

If Worksheets("Nedotykat sa!!!").Range("C3") Then

    With Sheets("Chain")

        Dim originalData as Variant
        originalData = .Range(.Range("A2"),.Range("B2").End(xlDown)) 'grab original data

        .cells(2,1).Resize(Ubound(y,2),2) = Application.Transpose(y) 'write new data
        .cells(.rows.count,1).End(xlUp).Offset(1).Resize(ubound(originalData,2),ubound(originalData,1)) = originalData 'write original data at the bottom

    End With

Else

    With Sheets("Chain")
        .Cells(.rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 2) = Application.Transpose(y)
    End With

End If

Answer 2

您可以通过三种方式两种进行此操作。首先，您可以使用Excel的内置方法进行复制和插入。
它很简单，如下所示：

Edit1 ：我调整了对最后一行的查找。这样将在Q列中找到具有值的最后一个单元格，如果未找到任何单元格，则最后一行-lr将设置为1000。

Dim lr As Long
With Sheets("Nastavit D")
  '// simply find the last row, can be done in various ways //
  'lr = .Range("Q" & .Rows.Count).End(xlUp).Row

   On Error Resume Next
   lr = .Range("Q:Q").Find(What:="*", LookIn:=xlValues, _
                           SearchDirection:=xlPrevious).Row
   If Err.Number <> 0 Then lr = 1000
   On Error GoTo 0

  .Range("Q2:R" & lr).Copy '// copy the data //
End With
'// insert data in target range //
Sheets("Chain").Range("A2").Insert xlDown

另一个正在使用数组，但我仍然使用Excel的插入方法，如下所示（混合）。

Dim lr As Long, v
With Sheets("Nastavit D")
  '// same as above, get the last row
  lr = .Range("Q" & .Rows.Count).End(xlUp).Row
  v = .Range("Q2:R" & lr) '// pass to array //
End With

With Sheets("Chain")
  '// insert a range the size of the array //
  .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Insert xlDown, xlFormatFromLeftOrAbove
  '// dump array in the space created //
  .Range("A2").Resize(UBound(v, 1), UBound(v, 2)) = v
End With

如果不需要做数组，我建议您做第一个。
已经提供了最后一种方法，您将两个数据都转储为posted。

如何在VBA中的现有单元格值之前插入单元格值

2 个答案: