将2张数据复制到单张纸上

我有两列数据，列和行。我想将这些数据添加到第三张表。

表1数据：

id sysid option status XYZ xyt o trade_1 US xyt c trade_1 Ust xt o trade_2 nj xt o trade_2 CHN zz c trade_3 rt zz o trade_3 

表2数据：

 id sysid matched option status XYZ xyt o trade_1 US xyt c trade_1 Ust xt o trade_2 nj xt o trade_2 CHN zz c trade_3 rt zz o trade_3 

sheet3中的输出应该如下所示：

 id sysid option status XYZ xyt o trade_1 US xyt c trade_1 CHN zz c trade_3 rt zz o trade_3 id sysid matched option status XYZ xyt o trade_1 US xyt c trade_1 CHN zz c trade_3 rt zz o trade_3 

下面的代码输出正确的数据，除了复制第一张数据之后，下一行数据将会显示结束

代码我正在尝试：

 Sub Tester() Dim rowCount As Integer rowCount = 1 Call Comparesheets("Sheet1", rowCount) rowCount = Sheets("Sheet3").UsedRange.Rows.Count Call Comparesheets("Sheet2", rowCount) End Sub Sub Comparesheets(sheetname As String, rowa As Integer) Const COL_ID As Integer = 1 Const COL_SYSID As Integer = 2 Dim COL_STATUS As Integer Dim COL_OPTION As Integer Dim rowstr As String Dim sheet1 As Boolean Dim sheet2 As Boolean Const VAL_DIFF As String = "XXdifferentXX" If sheetname = "Sheet1" Then COL_STATUS = 4 COL_OPTION = 3 sheet1 = True sheet2 = False Else sheet2 = True sheet1 = False COL_STATUS = 5 COL_OPTION = 4 End If Dim rowNum As Integer Dim d As Object, sKey As String, id As String Dim rw As Range, opt As String, rngData As Range Dim rngCopy As Range, goodId As Boolean Dim FirstPass As Boolean, arr Set POSOpen = ActiveWorkbook rowNum = 1 With Sheets(sheetname).Range("A1") Set rngData = .CurrentRegion.Offset(1).Resize( _ .CurrentRegion.Rows.Count - 1) End With Set rngCopy = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0) Set d = CreateObject("scripting.dictionary") FirstPass = True redo: For Each rw In rngData.Rows sKey = rw.Cells(COL_SYSID).Value & "<>" & _ rw.Cells(COL_STATUS).Value If FirstPass Then 'Figure out which combinations have different option values ' and at least one record with id=US or CHN id = rw.Cells(COL_ID).Value goodId = (id = "US" Or id = "CHN") opt = rw.Cells(COL_OPTION).Value If d.exists(sKey) Then arr = d(sKey) 'can't modify the array in situ... If arr(0) <> opt Then arr(0) = VAL_DIFF If goodId Then arr(1) = True d(sKey) = arr 'return [modified] array Else d.Add sKey, Array(opt, goodId) End If Else 'Second pass - copy only rows with varying options ' and id=US or CHN If d(sKey)(0) = VAL_DIFF And d(sKey)(1) = True Then If sheet1 Then Sheets("Sheet1").Rows(1).Copy Sheet3.Cells(1, 1) rw.Copy rngCopy ' rowNum = rowNum + 1 End If If sheet2 Then Sheets("Sheet2").Rows(1).Copy Sheet3.Cells(rowa + 1, 1) rw.Copy rngCopy End If Set rngCopy = rngCopy.Offset(1, 0) End If End If Next rw If FirstPass Then FirstPass = False GoTo redo End If End Sub 

Answer 1

改变这个：

 Set rngCopy = Sheet3.Range("A1") 

对此：

 Set rngCopy = Sheet3.Cells(Rows.Count, 1).End(xlUp).offset(2,0) If rngCopy.Row=2 then Set rngCopy=Sheet3.Range("A1") 

Answer 2

不清楚数据如何变化的规定，但是这样的事情应该相当快

  Sub main() Dim MyStuff As Variant MyStuff = Worksheets("Sheet2").Range("a2:d6").Value Worksheets("Sheet1").Range("A2:d6") = MyStuff MyStuff = Worksheets("Sheet3").Range("a2:d6").Value Worksheets("Sheet1").Range("a8:d12") = MyStuff End Sub 

还有其他方法可以相当快地使用。 像复制和粘贴例如，但它的使用语法是讨厌我。 我喜欢简单和容易记住，上面的代码是好的。

更多的阅读你的代码看起来像你正在寻找条件副本，但问题的顶部看起来像是相同的信息。 如果我误解了您的请求，请告诉我，我会尽量使我的代码适应您的需求。