尝试在Excel中合并列

时间:2011-09-12 08:36:39

标签: excel vba excel-vba

我很欣赏有很多类似的问题,但我现在已经在各种论坛上搜索了三天而且还没找到任何我需要的东西 - 所以要么我做的事情很奇怪,要么我的搜索技巧不是划伤!

如果有人能让我知道我哪里出错了,或者甚至将我联系到一个可能有帮助的解决方案,我真的很感激,因为我没有找到答案。

我目前有一个包含六个工作表的电子表格。工作表2-6包含从不同来源销售的项目的数据。工作表1当前包含四列,使用宏拼凑项目数据我已拼凑成四个单独的列。工作表2包含一个'itemlist'列,我想从工作表2中的四列中复制数据。

我希望这是有道理的。目前,我的代码如下:

Sub UpdateList()
  'Clear the current ranges
  Range("PharmacyItems").Clear
  Range("PrelabelItems").Clear
  Range("RestockItems").Clear
  Range("TakehomeItems").Clear
  Range("FullItemList").Clear

  'Populate control with unique list
  Range("PharmacyFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("PharmacyItems"), Unique:=True
  Range("PrelabelFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("PrelabelItems"), Unique:=True
  Range("RestockFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("RestockItems"), Unique:=True
  Range("TakehomeFullList").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("TakehomeItems"), Unique:=True

  'Combine the four ranges into one
  Range("UniqueLists!$A:$A, UniqueLists!$B:$B, UniqueLists!$C:$C, UniqueLists!$D:$D").Copy Sheets("Drug totals").Range("A2")
  'Sort the data
  Range("FullItemList").Sort Key1:=Range("FullItemList").Columns(1), Order1:=xlAscending, Orientation:=xlSortColumns, Header:=xlYes, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption2:=xlSortNormal
End Sub

为了澄清上述内容,以下是对哪个范围的定义:

PharmacyItems,PrelabelItems,RestockItems和TakehomeItems:这些是包含从每个数据工作表复制的唯一项目的单个列表。 FullList:以上四个中的fulllist是源数据列表,它们不是唯一列表 FullItemList:我想要来自唯一列表的所有数据的列

我有一个范围指定每个列而不是使用命名范围的原因是我试图看看这是否会使它变得更好,因为它最初只是给我一个模糊和蓬松的范围问题错误。使用范围中定义的列,它告诉我目标的大小/形状与源不匹配。

确切的错误是: 运行时错误'1004': 无法粘贴信息,因为复制区域和粘贴区域的大小和形状不同。请尝试以下方法之一: - 单击一个单元格,然后粘贴 - 选择一个大小和形状相同的矩形,然后粘贴

任何人都可以帮助我吗?可悲的是,我是一个SQL Server女孩,我宁愿从数据库中提取数据,但我不允许这样做!

提前谢谢

2 个答案:

答案 0 :(得分:4)

您无法将整个列粘贴到从第2行(或除1之外的任何其他行)开始的范围,因为该列的最后一行将不适合该工作表。这就是为什么Excel说“复制区域和粘贴区域的大小不同”。

而不是

Range("UniqueLists!$A:$A, UniqueLists!$B:$B, UniqueLists!$C:$C, UniqueLists!$D:$D").Copy Sheets("Drug totals").Range("A2")

尝试从第一行开始粘贴它。

Range("UniqueLists!A:D").Copy Sheets("Drug totals").Range("A1")

但我猜你没有数据一直到你的“UniqueLists”表的最底层?如果是这样,那么为什么要复制整个列?只需复制您需要的部分。然后你就可以在单元格“A2”上粘贴。例如:

Range("UniqueLists!A1:D1234").Copy Sheets("Drug totals").Range("A2")

答案 1 :(得分:0)

如果您不需要单独的唯一列表,但只想创建一个包含所有唯一值的列,那么这应该适用于您(虽然未经测试...)

Sub UpdateList()

   Range("FullItemList").Clear  'Clear the full item list range

   'Populate control with unique list
   UniquesToFullItemList Range("PharmacyFullList")
   UniquesToFullItemList Range("PrelabelFullList")
   UniquesToFullItemList Range("RestockFullList")
   UniquesToFullItemList Range("TakehomeFullList")

   'Sort the data
   Range("FullItemList").Sort Key1:=Range("FullItemList").Columns(1), _
      Order1:=xlAscending, Orientation:=xlSortColumns, Header:=xlYes, _
      SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
      DataOption2:=xlSortNormal

End Sub

Sub UniquesToFullItemList(rngFrom As Range)
   rngFrom.AdvancedFilter Action:=xlFilterCopy, _
     CopyToRange:=Sheets("Drug totals").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), _
             Unique:=True
End Sub