Question

希望这是有道理的：我有一个“主”电子表格，列中包含项目1-100。项目1（例如）下面有4列（因此A1：D1合并，但从第2行向下，它们仍然是单独的列）。第2项只是一列，但3下面有2列。这些项目没有押韵或理由，或者下面有多少列，但它们不会改变。

我正在寻找一种方法去另一个标签（称之为sheet1）并在单个单元格（1,15,35,84,99）中键入我想要的页面顶部的数字并拥有宏从“master”中复制相应的列并按顺序粘贴它们。

希望这很有意义，也很容易。我想在“主”选项卡中将“1”定义为单元格A1：D26，每当“sheet1”中有“1”时，它复制数组并粘贴它，然后转到下一个数字“15”并执行同样的事情已经定义。我必须以某种方式定义所有数组，但就像我说的那样，那些不会改变。

任何建议都会很棒。

感谢

亚当

Answer 1

以下代码应该完全符合您的要求;我不认为它需要解释超出变量名称和注释中的内容。

Option Explicit

Sub copyMerged()
Dim wsMaster As Worksheet
Dim wsTarget As Worksheet
Dim rNumbers As Range
Dim rSource As Range
Dim rDest As Range

Application.ScreenUpdating = False

Set wsMaster = ActiveWorkbook.Sheets("Master")
Set wsTarget = ActiveWorkbook.Sheets("Sheet1")

' delete all cells below first row
' otherwise we'll run in trouble with merged cells
wsTarget.Range([2:2], wsTarget.Cells.SpecialCells(xlCellTypeLastCell)).Delete
Set rNumbers = wsTarget.[A1]
Set rDest = wsTarget.[A2]
While Not IsEmpty(rNumbers)
  Set rSource = getRange(wsMaster, Int(rNumbers.Value))
  Set rNumbers = rNumbers.Offset(0, 1)
  rSource.Copy
  rDest.PasteSpecial
  Set rDest = rDest.Offset(0, 1).Cells(1, 1)
Wend

End Sub

Function getRange(ws As Worksheet, v As Integer) As Range
' return the vth merged cell in top row of ws
' and return the range from there to the bottom
Dim ii
Dim r As Range
Set r = ws.[A1]

For ii = 1 To v - 1
  Set r = r.Offset(0, 1)
Next ii

' select the entire merged cell... a bit weird
Set r = Range(r, r.Offset(0, 1).Offset(0, -1))

' extend to the last cell in the block below this
Dim r2 As Range
Set r2 = r.Offset([A:A].Rows.Count - 1, 0).End(xlUp)

Set getRange = Range(r, r2)

End Function

根据第一列从一个电子表格中复制和粘贴数组

1 个答案: