从一张纸复制数据并将其粘贴到另一张纸上

Posted 2023-03-27

【中文标题】从一张纸复制数据并将其粘贴到另一张纸上

【英文标题】：Copy the data from one sheet and paste it on the other sheet

【发布时间】：2020-06-12 06:07:33

【问题描述】：

如果满足给定条件，我需要一个 excel vba 代码，它可以。工作簿中将有两张工作表（工作表 1 和工作表 2）。基本上，表 2 列“C”中的数据必须复制到表 1 列“C”。

条件是：-

SHEET 1&2 A,B,C 中将包含三列。

如果 SHEET 1 B1 有一个数据让我们获取（“88”）。现在，它应该搜索 sheet2 B:B 中有多少个（“88”）。

如果有多个让我们取“4”，那么那些“4” sheet2 “C”值属于 sheet 1 “A1”。它应该使用“sheet1 A1 & B1”值创建另外三行，那么这 4 个值必须是 在这四个“Sheet A1&B1”旁边粘贴“sheet1”c”。我无法选择这 4 个 SHEET2“C”值

如果有一个“88”，那么它可以粘贴在 sheet1“C1”。

这样，它应该对工作表 1 B:B 中的每个值都执行此操作。

至少告诉我用什么代码通过vba添加具有单元格值的行

如何找到值并复制相应的单元格

Sub copythedata()

 Dim r As Long, ws As Worksheet, wd As Worksheet

 Dim se As String
 Dim sf As String
 Dim fn As Integer
 Dim y As Integer
 Dim lrow As Long

 Set ws = Worksheets("sheet2")
 Set wd = Worksheets("sheet1")

    y = 123
    x = wd.Cells(Rows.Count, 1).End(xlUp).Row
    MsgBox "Last Row: " & x
If x > y Then
    wd.Range(wd.Cells(y, 1), wd.Cells(x, 1)).EntireRow.Delete Shift:=xlUp
End If

    For r = wd.Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1

fn = Application.WorksheetFunction.countif(ws.Range("B:B"), wd.Range("B" & r).Value)


        If fn = 1 Then
        wd.Range("C" & r).Value = ws.Range("C" & r).Value

        ElseIf fn > 1 Then
        se = wd.Range(wd.Cells(A, r), wd.Cells(B, r)).EntireRow.Copy

        wd.Range("A123").Rows(fn - 1).Insert Shift:=xlShiftDown

        Else

        wd.Range("C" & r).Value = "NA"


        End If
    Next r

End Sub

【问题讨论】：

如果您“需要代码”，那么为什么不直接创建一个呢？将其分解为各个部分并学习如何完成每一部分，然后将它们全部放在一起......当您遇到一块时，请在您的问题中发布您的代码并询问您的尝试为什么不起作用。就目前而言，除了告诉我们您想要/需要什么之外，您没有表现出任何努力。

然后告诉我用什么代码来统计数据（比如 COUNTIF ）

这完全取决于您使用的代码，您没有与我们分享。

每张纸有多少行数百，数千，超过一万？

在工作表 1 中有 123 行，工作表 2 有近 200 行

【参考方案1】：

见Find 和 FindNext

使用 FindNext 时，请参阅备注部分，了解如何在“环绕”之后停止搜索到开始，否则会陷入无限循环。

Option Explicit
Sub copythedata()

    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim iLastRow1 As Integer, iLastRow2 As Long
    Dim iRow As Integer, iNewRow As Long, iFirstFound As Long
    Dim rngFound As Range, rngSearch As Range
    Dim cell As Range, count As Integer

    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("sheet2")

    ' sheet 2 range to search
    iLastRow2 = ws2.Range("B" & Rows.count).End(xlUp).Row
    Set rngSearch = ws2.Range("B1:B" & iLastRow2)

    'Application.ScreenUpdating = False

    ' sheet1 range to scan
    iLastRow1 = ws1.Range("B" & Rows.count).End(xlUp).Row

    ' add new rows after a blank row to easily identify them
    iNewRow = iLastRow1 + 1

    For iRow = 1 To iLastRow1
        Set cell = ws1.Cells(iRow, 2)

        Set rngFound = rngSearch.Find(what:=cell.Value, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)

        If rngFound Is Nothing Then
            'Debug.Print "Not found ", cell
            cell.Offset(0, 1) = "NA"
        Else
            iFirstFound = rngFound.Row
            Do
                'Debug.Print cell, rngFound.Row
                If rngFound.Row = iFirstFound Then
                   cell.Offset(0, 1) = rngFound.Offset(0, 1).Value
                Else
                   iNewRow = iNewRow + 1
                   ws1.Cells(iNewRow, 1) = cell.Offset(, -1)
                   ws1.Cells(iNewRow, 2) = cell.Offset(, 0)
                   ws1.Cells(iNewRow, 3) = rngFound.Offset(0, 1).Value
                End If
                Set rngFound = rngSearch.FindNext(rngFound)
            Loop Until rngFound.Row = iFirstFound
        End If

    Next

    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation

End Sub