将不连续的范围从一张纸复制到另一张 [英] Copying a discontinuous range from one sheet to another

问题描述

这里的VBA新秀（和首次海报）可能是一个非常基本的问题。但是，我没有在互联网上的任何地方找到答案（或参考书），所以我很沮丧。

在一张纸上放一堆间隔的列，并将它们填充到另一张纸上，但没有间隙？

例如，我要复制单元格标记为x的表单，如下所示：

  x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
 x。 。 。 x x。 。 X 。 。 x 
  

转到不同的表格：

  xxxxx。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
 x x x x x。 。 。 。 。 
  

设计约束：

• 源范围是不连贯的列。目的地是连续块
  
  
  
  • 例如。来源A3：B440，G3：G440，I3：I440 - >目的地A3：D440
  
  


• 只有这些值。目标具有需要保留的条件格式


• 目标是ListObject的DataBodyRange的一部分


• 源范围列是任意的。它们由标题索引功能找到。


• 行数是任意的，但源和目的地都相同。


• 有我试图复制的大约400行和10-15列。循环是烦人的。

这个代码片段完成了这个工作，但是它反复地弹起来的东西太多了，太长。我觉得这是错误的做法。

 对于每个hdrfield在ExportFields 
 
 RawDataCol = s_RawData.HeaderColumnPositions（hdrfield）
 
 s_RawData.Activate 
 s_RawData.Range（s_RawData.Cells（3，RawDataCol），s_RawData.Cells（LastRow，RawDataCol））。复制（s_Console.Range （s_Console.Cells（3，i），s_Console.Cells（LastRow，i）））
 s_Console.Activate 
 s_Console.Range（s_Console.Cells（3，i），s_Console.Cells（LastRow， i））。选择
 s_Console.Paste 
 
i = i + 1 
 
下一页hdrfield 
  

这种方法也有效。它更快，可靠。这是我一直在做的，但对源头位置的硬编码不再有效了。

 从原始数据表到报告行表的重要列
 s_Console.Range（A3：A& upperlimit）.Value = s_RawData.Range（A3：A& upperlimit）.Value'timestamp 
 s_Console.Range（B3：B& upperlimit）.Value = s_RawData.Range（I3：I& upperlimit）.Value'H2.ppm 
 s_Console.Range（C3： C& upperlimit）.Value = s_RawData.Range（J3：J& upperlimit）.Value'H2_DG.ppm 
 s_Console.Range（D3：D& upperlimit）.Value = s_RawData。范围（K3：K& upperlimit）.Value'OilTemp或GasTemp 
 s_Console.Range（E3：E& upperlimit）.Value = s_RawData.Range（L3：L& upperlimit） .Value'H2_G.ppm 
 s_Console.Range（F3：F& upperlimit）.Value = s_RawData.Range（q3：q& upperlimit）.Value'H2_mt 
 s_Console.Range （G3：G& upperlimit）.Value = s_RawData.Range（r3：r& upperlimit）.Value 'H2_oo 
 s_Console.Range（H3：H&上限）.Value = s_RawData.Range（s3：s& upperlimit）.Value'H2_lg 
 s_Console.Range（I3：I& upperlimit）.Value = s_RawData.Range（t3：t & upperlimit）.Value'R1 
 s_Console.Range（J3：J& upperlimit）.Value = s_RawData.Range（u3：u& upperlimit）.Value'R2 
 s_Console.Range（K3：K& upperlimit）.Value = s_RawData.Range（ab3：ab& upperlimit）.Value't1 
 s_Console.Range（L3：L& upperlimit） .Value = s_RawData.Range（ac3：ac& upperlimit）.Value't2 
 s_Console.Range（M3：M& upperlimit）.Value = s_RawData.Range（ah3：Ah& ;上限）.Value'循环类型
  

为什么我不能混合两者？为什么这段代码不工作？

  s_console.range（A3：M& lastrow）.value = s_rawdata。 exportrange 
  

（我已经有一个自定义的exportrange属性，可以选择+复制范围我想要...但是我不能设置另一个范围的值，因为它是不连续的）

感谢您的帮助！这似乎是一个基本的学习VBA，我只是找不到任何有关的信息。

-Matt

解决方案

需要注意的一点是，您可以一次复制整个不连续的范围，如下所示：

  Sheet1.Range（A3：B440，G3：G440，I3：I440）。复制
 Sheet2.Range（A3）PasteSpecial xlValues 
 代码名称中，但是您可能会使用 ThisWorkbook.Worksheets（mySheet） / p> 
 
 
我真的不能确定你还要做什么，所以我只是写了一些代码。通过使用Find和FindNext查找要复制的列，在第2行中搜索copy列：
  Sub CopyDiscontiguousColumns ）
 Dim wsFrom As Excel.Worksheet 
 Dim wsTo As Excel.Worksheet 
 Dim RangeToCopy As Excel.Range 
 Dim HeaderRange As Excel.Range 
 Dim HeaderText As String 
 Dim FirstFoundHeader As Excel.Range 
 Dim NextFoundHeader As Excel.Range 
 Dim LastRow As Long 
 
设置wsFrom = ThisWorkbook.Worksheets（1）
设置wsTo = ThisWorkbook.Worksheets（2）
'头在行2 
 Set HeaderRange = wsFrom.Rows（2）
'这是标识要复制的列的文本
 HeaderText =copy
使用wsFrom 
'在标题行中查找copy的第一个实例
 Set FirstFoundHeader = HeaderRange.Find（HeaderText）
'如果copy被发现，我们关闭并运行
如果不是FirstFoundHeader没有，然后
 LastRow = .Cells（.Rows.Count，FirstFoundHeader.Colu mn）.End（xlUp）.Row 
设置NextFoundHeader = FirstFoundHeader 
'开始使用要复制的列创建范围
设置RangeToCopy = .Range（.Cells（3，NextFoundHeader.Column） ，.Cells（.Rows.Count，NextFoundHeader.Column））
'，然后在循环中继续做同样的事情，直到我们回到起始
 Do 
 Set NextFoundHeader = HeaderRange FindNext（NextFoundHeader）
如果不是NextFoundHeader是没有
设置RangeToCopy = Union（RangeToCopy，.Range（.Cells（3，NextFoundHeader.Column），.Cells（.Rows.Count，NextFoundHeader.Column ）））
 End If 
循环而不是NextFoundHeader是Nothing和NextFoundHeader.Address<> FirstFoundHeader.Address 
 End If 
 End With 
 RangeToCopy.Copy 
 Sheet2.Range（A3）。PasteSpecial xlValues 
 End Sub 
  
 
VBA rookie here (and first-time poster) with what is probably a pretty basic question. However, I haven't found an answer anywhere on the internet (or in the reference books I have) so I'm pretty stumped.

how can I take a bunch of spaced-out columns in one sheet and stuff them into another sheet, but without the gaps?

For example, I want to copy the cells marked as x's from a sheet like this:
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
x . . . x x . . x . . x
To a different sheet like this:
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
x x x x x . . . . . 
Design constraints:


Source range is disjointed columns. Destination is continuous block

e.g. Source "A3:B440, G3:G440, I3:I440" -> destination "A3:D440"

Only the values. Destination has conditional formatting that needs to be preserved
Destination is part of the DataBodyRange of a ListObject
The source range columns are arbitrary. They're found by a header indexing function.
The row-count is arbitrary, but the same for both source and destination.
There are about 400 rows and 10-15 columns I'm trying to copy. Loops are... annoying.


This snippets gets the job done, but it bounces things back and forth too much, and takes way too long. I feel like this is The Wrong Way To Do It.
For Each hdrfield In ExportFields

    RawDataCol = s_RawData.HeaderColumnPositions(hdrfield)

    s_RawData.Activate
    s_RawData.Range(s_RawData.Cells(3, RawDataCol), s_RawData.Cells(LastRow, RawDataCol)).Copy (s_Console.Range(s_Console.Cells(3, i), s_Console.Cells(LastRow, i)))
    s_Console.Activate
    s_Console.Range(s_Console.Cells(3, i), s_Console.Cells(LastRow, i)).Select
    s_Console.Paste

    i = i + 1

Next hdrfield
This approach also works. It's faster, and it's reliable. It's what I've been doing, but hard-coding the source positions isn't going to work anymore.
'transfer just the important columns from the raw data sheet to the report line sheet
s_Console.Range("A3:A" & upperlimit).Value = s_RawData.Range("A3:A" & upperlimit).Value 'timestamp
s_Console.Range("B3:B" & upperlimit).Value = s_RawData.Range("I3:I" & upperlimit).Value 'H2.ppm
s_Console.Range("C3:C" & upperlimit).Value = s_RawData.Range("J3:J" & upperlimit).Value 'H2_DG.ppm
s_Console.Range("D3:D" & upperlimit).Value = s_RawData.Range("K3:K" & upperlimit).Value 'OilTemp or GasTemp
s_Console.Range("E3:E" & upperlimit).Value = s_RawData.Range("L3:L" & upperlimit).Value 'H2_G.ppm
s_Console.Range("F3:F" & upperlimit).Value = s_RawData.Range("q3:q" & upperlimit).Value 'H2_mt
s_Console.Range("G3:G" & upperlimit).Value = s_RawData.Range("r3:r" & upperlimit).Value 'H2_oo
s_Console.Range("H3:H" & upperlimit).Value = s_RawData.Range("s3:s" & upperlimit).Value 'H2_lg
s_Console.Range("I3:I" & upperlimit).Value = s_RawData.Range("t3:t" & upperlimit).Value 'R1
s_Console.Range("J3:J" & upperlimit).Value = s_RawData.Range("u3:u" & upperlimit).Value 'R2
s_Console.Range("K3:K" & upperlimit).Value = s_RawData.Range("ab3:ab" & upperlimit).Value 't1
s_Console.Range("L3:L" & upperlimit).Value = s_RawData.Range("ac3:ac" & upperlimit).Value 't2
s_Console.Range("M3:M" & upperlimit).Value = s_RawData.Range("ah3:Ah" & upperlimit).Value 'Cycle Type
Why can't I just have a hybrid of the two? Why won't this code work?
 s_console.range("A3:M" & lastrow).value = s_rawdata.exportrange
(i've already got a custom "exportrange" property written, which can select + copy the range I want... but I can't set the values of another range with it because it's discontinuous) 

Thanks for the help! This seems like a fundamental piece of learning VBA that I just can't find any information about.

-Matt
解决方案
The key thing to be aware of is that you can copy the whole discontinuous range at once, like this:
Sheet1.Range("A3:B440, G3:G440, I3:I440").Copy
Sheet2.Range("A3").PasteSpecial xlValues
Note that in the above Sheet1 and Sheet2 are codenames, but you'll probably use something like ThisWorkbook.Worksheets("mySheet").

I couldn't really be sure what else you're trying to do, so I just wrote some code. This finds the columns to copy by using Find and FindNext, searching for columns with "copy" in row 2:
Sub CopyDiscontiguousColumns()
Dim wsFrom As Excel.Worksheet
Dim wsTo As Excel.Worksheet
Dim RangeToCopy As Excel.Range
Dim HeaderRange As Excel.Range
Dim HeaderText As String
Dim FirstFoundHeader As Excel.Range
Dim NextFoundHeader As Excel.Range
Dim LastRow As Long

Set wsFrom = ThisWorkbook.Worksheets(1)
Set wsTo = ThisWorkbook.Worksheets(2)
'headers are in row 2
Set HeaderRange = wsFrom.Rows(2)
'This is the text that identifies columns to be copies
HeaderText = "copy"
With wsFrom
    'look for the first instance of "copy" in the header row
    Set FirstFoundHeader = HeaderRange.Find(HeaderText)
    'if "copy" is found, we're off and running
    If Not FirstFoundHeader Is Nothing Then
        LastRow = .Cells(.Rows.Count, FirstFoundHeader.Column).End(xlUp).Row
        Set NextFoundHeader = FirstFoundHeader
        'start to build the range with columns to copy
        Set RangeToCopy = .Range(.Cells(3, NextFoundHeader.Column), .Cells(.Rows.Count, NextFoundHeader.Column))
        'and then just keep doing the same thing in a loop until we get back to the start
        Do
        Set NextFoundHeader = HeaderRange.FindNext(NextFoundHeader)
            If Not NextFoundHeader Is Nothing Then
                Set RangeToCopy = Union(RangeToCopy, .Range(.Cells(3, NextFoundHeader.Column), .Cells(.Rows.Count, NextFoundHeader.Column)))
            End If
        Loop While Not NextFoundHeader Is Nothing And NextFoundHeader.Address <> FirstFoundHeader.Address
    End If
End With
RangeToCopy.Copy
Sheet2.Range("A3").PasteSpecial xlValues
End Sub


                        
这篇关于将不连续的范围从一张纸复制到另一张的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！