excel - 从一张纸复制数据并将其粘贴到另一张纸上
问题描述
如果满足给定条件,我需要一个 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
解决方案
使用 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
推荐阅读
- bash - 为什么在条件中打印的 null 与文字 null 的处理方式不同?
- android - Android 上的增量机器学习
- graphql - GraphQL:一个接口可以用来统一两个等价属性名称不同的类型吗?
- css - 如何在导航栏中将按钮浮动到右侧,以免影响主导航栏?
- angular - 尝试使用对象属性访问文档信息
- javascript - componentDidMount() 中的“这是未定义”错误
- mysql - 从文本列中选择小时
- swift - 由于未捕获的异常'NSInvalidArgumentException'而终止应用程序,原因:'-[UIImageView _isResizable]:
- dart - 如何覆盖子类中的类变量?
- c# - Unity HoloLens 应用程序作为 Windows 应用程序而不是 AR 执行