复制并粘贴带有条件的数据

问题描述

我有工作簿（第 7 阶段 MPR 模板），我将在其中上传文件（DDMR 第 7 阶段更新）。然后将数据粘贴到工作表（“摘要”）。当我单击运行时，数据将分发到具有匹配工作表名称的其他工作表（如果“摘要”的 A 列中的值与工作表名称匹配，它们将被分发到该工作表）。它工作得很好。不过有一个问题。一个条件是，如果“摘要”的 G 列中的值相同，则应将它们并排粘贴。如果没有，它们将彼此相距 11 个增量粘贴。该代码适用于 G 列中的不同值。但是，此代码不适用于 G 中的类似值。但此代码适用于我的其他模板。所以我不明白代码有什么问题。请帮忙！ :(

我有以下文件：MACRO FILES

Sub copy_Data()

Dim lastRow As Long,firstRow As Long,i As Long,pasteRow As Long,increment As Long,k As 
 Long
  Dim DD As String,prevDD As String
  Dim j As Worksheet,Unitsheet As Worksheet,summarySheet As Worksheet

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False

  Set summarySheet = Worksheets("Summary")
  lastRow = summarySheet.Columns("A").Find("*",searchorder:=xlByRows,searchdirection:=xlPrevIoUs).Row 'last row on 'Summary' sheet
    firstRow = 30
    increment = 11

 For Each j In ThisWorkbook.Worksheets

   k = 0 'variable for downtime details value
  For i = 2 To lastRow
     If summarySheet.Cells(i,"A") = j.Name Then
      DD = summarySheet.Cells(i,"G").Value
      Set Unitsheet = Worksheets(j.Name)
      pasteRow = Unitsheet.Columns("BZ").Find("*",searchdirection:=xlPrevIoUs).Row 'last row on NOSheet
      
       If pasteRow = 1 Then '1st,column W has only 1 row
        k = k + 1 'it means in every loop,k is increasing by 1
        pasteRow = firstRow
            
       ElseIf pasteRow > 1 Then 'After the 1st loop of if pasterow=1,there is data on column 
   W firstRow,so pasterow(32)>1
        prevDD = Unitsheet.Cells(pasteRow,"J")
        
         If prevDD = DD Then 'if the downtime details consecutively are the same values
          pasteRow = pasteRow + 1
         Else
          k = k + 1
          pasteRow = 19 + (increment * k) '21+(11*2,3,etc)
         End If

        End If
            
       Unitsheet.Cells(pasteRow,"BZ") = summarySheet.Cells(i,"A")
       Unitsheet.Cells(pasteRow,"E") = summarySheet.Cells(i,"D")
       Unitsheet.Cells(pasteRow,"F") = summarySheet.Cells(i,"E")
       Unitsheet.Cells(pasteRow,"G") = summarySheet.Cells(i,"F")
       Unitsheet.Cells(pasteRow,"J") = DD
       Unitsheet.Cells(pasteRow,"K") = summarySheet.Cells(i,"H")
       Unitsheet.Cells(pasteRow,"L") = summarySheet.Cells(i,"I")
       Unitsheet.Cells(pasteRow,"Q") = summarySheet.Cells(i,"K")
       Unitsheet.Cells(pasteRow,"R") = summarySheet.Cells(i,"J")
            
  End If
  
Next i

 Next j

  Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub

1.文本框中的文件是点击浏览后上传的

2.上传后，文件中的数据将粘贴到“摘要”工作表中。请注意，在红色圈出的数据中，它们在 G 列中具有相似的值，工作表名称为 MG21709

3.点击运行后，应该会出现这个

4.然而，这反而出现了:(

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）