excel - 具有匹配工作表名称和多个条件的 VBA 复制和粘贴数据
问题描述
我是 VBA 新手,所以我不是那么好。这是我第一个问题的后续问题。具有匹配工作表名称的 VBA 复制和粘贴数据
我有一个工作簿,其中包含工作表“摘要”(所有数据都被合并,如图 1 所示)、“8”、“9”、“10”。我想从“摘要”中复制数据,条件是如果 A 列中的单元格包含工作表名称(8,9 或 10),则该单元格的行和列 C 到 E 将粘贴到具有匹配名称的工作表中(显示在图 2)。数据将粘贴在固定范围 C7 到 E7、C14 到 E14、C21 到 E21 等(7 增量)中。但是,如果“摘要”的 B 列中的连续行具有相同的值,它们将被粘贴在一起(模糊)。例如,“摘要”中的 A 列中的第 2 到 6 行中的单元格包含“8”,但列B 行 2 和 3 具有相似的值,因此列 C 到 E 行 2 到 6 将被复制并粘贴到 C7 列的工作表“8”,https://drive.google.com/file/d/18UalCvxIXuP6imVWZsWLRZPghMqogZp8/view?usp=sharing
我有上一个线程的 ff 代码,也许你可以添加或修改一些东西:
Sub Copy_Data()
Dim lastRow As Long, offsetRow As Long, i As Long, No As String, NOSheet As Worksheet, auxRow As Long, summarySheet As Worksheet
Set summarySheet = Worksheets("Summary")
lastRow = summarySheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
offsetRow = 7
For i = 2 To lastRow
No = Cells(i, "A")
Set NOSheet = Worksheets(No)
auxRow = NOSheet.Columns("C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If auxRow > 1 Then auxRow = auxRow + 2
If auxRow = 1 Then auxRow = offsetRow
NOSheet.Cells(auxRow, "C") = summarySheet.Cells(i, "C")
NOSheet.Cells(auxRow, "D") = summarySheet.Cells(i, "D")
NOSheet.Cells(auxRow, "E") = summarySheet.Cells(i, "E")
Next i
结束子
谢谢您的帮助!!!
解决方案
为了比较 SMR 列,我还将该列复制到表 8、9、10 中。我还添加了一些评论。
Sub Copy_Data()
Dim lastRow As Long, firstRowToCopyData As Long, i As Long, No As Integer, NOSheet As Worksheet, auxRow As Long, summarySheet As Worksheet
Dim increment As Long, SMR As String, prevSMR As String, firstNO As Integer, lastNO As Integer, k As Long
Set summarySheet = Worksheets("Summary")
lastRow = summarySheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'last row on Summary sheet
firstRowToCopyData = 7
increment = 7
firstNO = 8
lastNO = 10
For No = firstNO To lastNO
k = 0 'we use this varible to count unique SMR values
For i = 2 To lastRow
If summarySheet.Cells(i, "A") = No Then
SMR = summarySheet.Cells(i, "B")
Set NOSheet = Worksheets(CStr(No)) 'assuming sheets 8,9,10,etc already exists
auxRow = NOSheet.Columns("C").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'last row on NOSheet
If auxRow > 1 Then 'if there is existing data in NOSheet
prevSMR = NOSheet.Cells(auxRow, "B")
If prevSMR = SMR Then 'if consecutive same SMR value
auxRow = auxRow + 1
Else
k = k + 1
auxRow = increment * k 'auxRow=7,14,21...
End If
ElseIf auxRow = 1 Then
k = k + 1
auxRow = firstRowToCopyData 'same than increment*k because firstRowToCopyData=increment
End If
NOSheet.Cells(auxRow, "A") = No
NOSheet.Cells(auxRow, "B") = SMR
NOSheet.Cells(auxRow, "C") = summarySheet.Cells(i, "C")
NOSheet.Cells(auxRow, "D") = summarySheet.Cells(i, "D")
NOSheet.Cells(auxRow, "E") = summarySheet.Cells(i, "E")
End If
Next i
Next No
End Sub
推荐阅读
- c# - .NET CORE 3.1 ApiController 装饰器是否使用 System.Text.Json 返回 json?
- javascript - 如何从不同的 HTML 文件调用 JavaScript 函数?
- python - 正则表达式返回两个数字?
- android - 我无法在 Android Studio 中运行模拟器
- regex - 如何在JMeter的while控制器中保存特定采样器的响应主体
- reactjs - 有没有办法在 React 中显示图像之前加载它们?
- php - 如何保护 HTML 表单免受 XSS 攻击?
- memory - 对英特尔傲腾的内存驱动技术 (IMDT) 和 DCPMM 内存模式之间的区别感到困惑
- python - 如何在 TensorFlow v2 中传递会话对象?
- react-native - react-native-document-picker uri 获取 rael 路径获取