Question

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

表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

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

我正在尝试的代码：

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

还有其他方法可以很快使用。比如复制和粘贴，例如，它的使用语法对我来说很烦人。我喜欢简单易记，上面的代码对此有好处。

更多地阅读您的代码看起来您正在寻找有条件的副本，但问题的顶部看起来是相同的信息。如果我误解了您的请求，请告诉我，我会尝试根据您的需求调整我的代码。

将数据从2张复制到单张

2 个答案: